Theory List_Supplement
theory List_Supplement
imports Main
begin
list_foot:
assumes "l ≠ []"
obtains y ys where "l = ys @ [y]"
proof -
{
assume a: "l ≠ []"
have "∃y ys. l = ys @ [y]"
using a
proof (induction l)
case (Cons a l)
then show ?case
proof (cases "l = []")
case True
have "[] @ [a] = a # l"
using True
by simp
thus ?thesis
using Cons.prems(1)
by simp
next
case False
thm Cons
then obtain y ys where "l = ys @ [y]"
using Cons.IH
by blast
then have "a # l = a # ys @ [y]"
by blast
thus ?thesis
by fastforce
qed
qed simp
}
thus ?thesis
using assms that
by blast
qed
lemma list_ex_intersection: "list_ex (λv. list_ex ((=) v) ys) xs ⟷ set xs ∩ set ys ≠ {}"
proof -
{
assume "list_ex (λv. list_ex ((=) v) ys) xs"
then have "∃v ∈ set xs. list_ex ((=) v) ys"
using list_ex_iff
by fast
moreover have "∀v. list_ex ((=) v) ys = (∃v' ∈ set ys. v = v')"
using list_ex_iff
by blast
ultimately have "∃v ∈ set xs. (∃v' ∈ set ys. v = v')"
by blast
then obtain v v' where "v ∈ set xs" and "v' ∈ set ys" and "v = v'"
by blast
then have "set xs ∩ set ys ≠ {}"
by blast
} moreover {
assume "set xs ∩ set ys ≠ {}"
then obtain v v' where "v ∈ set xs" and "v' ∈ set ys" and "v = v'"
by blast
then have "list_ex (λv. ∃v' ∈ set ys. v = v') xs"
using list_ex_iff
by fast
moreover have "∀v. (∃v' ∈ set ys. v = v') = list_ex ((=) v) ys"
using list_ex_iff
by blast
ultimately have "list_ex (λv. list_ex ((=) v) ys) xs"
by force
} ultimately show ?thesis
by blast
qed
lemma length_map_upt: "length (map f [a..<b]) = b - a"
proof -
have "length [a..<b] = b - a"
using length_upt
by blast
moreover have "length (map f [a..<b]) = length [a..<b]"
by simp
ultimately show ?thesis
by argo
qed
lemma not_list_ex_equals_list_all_not: "(¬list_ex P xs) = list_all (λx. ¬P x) xs"
proof -
have "(¬list_ex P xs) = (¬Bex (set xs) P)"
using list_ex_iff
by blast
also have "… = Ball (set xs) (λx. ¬P x)"
by blast
finally show ?thesis
by (simp add: Ball_set_list_all)
qed
lemma element_of_subseqs_then_subset:
assumes "l ∈ set (subseqs l')"
shows"set l ⊆ set l'"
using assms
proof (induction l' arbitrary: l)
case (Cons x l')
have "set (subseqs (x # l')) = (Cons x) ` set (subseqs l') ∪ set (subseqs l')"
unfolding subseqs.simps(2) Let_def set_map set_append..
then consider (A) "l ∈ (Cons x) ` set (subseqs l')"
| (B) "l ∈ set (subseqs l')"
using Cons.prems
by blast
thus ?case
proof (cases)
case A
then obtain l'' where "l'' ∈ set (subseqs l')" and "l = x # l''"
by blast
moreover have "set l'' ⊆ set l'"
using Cons.IH[of l'', OF calculation(1)].
ultimately show ?thesis
by auto
next
case B
then show ?thesis
using Cons.IH
by auto
qed
qed simp
text ‹ Embed a list into a list of singleton lists. ›
primrec embed :: "'a list ⇒ 'a list list"
where "embed [] = []"
| "embed (x # xs) = [x] # embed xs"
lemma set_of_embed_is: "set (embed xs) = { [x] | x. x ∈ set xs }"
by (induction xs; force+)
lemma concat_is_inverse_of_embed:
"concat (embed xs) = xs"
by (induction xs; simp)
lemma embed_append[simp]: "embed (xs @ ys) = embed xs @ embed ys"
proof (induction xs)
case (Cons x xs)
have "embed (x # xs @ ys) = [x] # embed (xs @ ys)"
try0
by simp
also have "… = [x] # (embed xs @ embed ys)"
using Cons.IH
by simp
finally show ?case
by fastforce
qed simp
end
Theory Map_Supplement
theory Map_Supplement
imports Main
begin
lemma map_of_defined_if_constructed_from_list_of_constant_assignments:
"l = map (λx. (x, a)) xs ⟹ ∀x ∈ set xs. (map_of l) x = Some a"
proof (induction xs arbitrary: l)
case (Cons x xs)
let ?l' = "map (λv. (v, a)) xs"
from Cons.prems(1) have "l = (x, a) # map (λv. (v, a)) xs"
by force
moreover have "∀v ∈ set xs. (map_of ?l') v = Some a"
using Cons.IH[where l="?l'"]
by blast
ultimately show ?case
by auto
qed auto
lemma map_of_from_function_graph_is_some_if:
fixes f :: "'a ⇒ 'b"
assumes "set xs ≠ {}"
and "x ∈ set xs"
shows "(map_of (map (λx. (x, f x)) xs)) x = Some (f x)"
using assms
proof (induction xs arbitrary: f x)
case (Cons a xs)
thm Cons
let ?m = "map_of (map (λx. (x, f x)) xs)"
have a: "map_of (map (λx. (x, f x)) (Cons a xs)) = ?m(a ↦ f a)"
unfolding map_of_def
by simp
thus ?case
proof(cases "x = a")
case False
thus ?thesis
proof (cases "set xs = {}")
case True
thus ?thesis
using Cons.prems(2)
by fastforce
next
case False
then have "x ∈ set xs"
using ‹x ≠ a› Cons.prems(2)
by fastforce
moreover have "map_of (map (λx. (x, f x)) (Cons a xs)) x = ?m x"
using ‹x ≠ a›
by fastforce
ultimately show ?thesis
using Cons.IH[OF False]
by presburger
qed
qed force
qed blast
lemma foldl_map_append_is_some_if:
assumes "b x = Some y ∨ (∃m ∈ set ms. m x = Some y)"
and "∀m' ∈ set ms. m' x = Some y ∨ m' x = None"
shows "foldl (++) b ms x = Some y"
using assms
proof (induction ms arbitrary: b)
case (Cons a ms)
consider (b_is_some_y) "b x = Some y"
| (m_is_some_y) "∃m ∈ set (a # ms). m x = Some y"
using Cons.prems(1)
by blast
hence "(b ++ a) x = Some y ∨ (∃m∈set ms. m x = Some y)"
proof (cases)
case b_is_some_y
moreover have "a x = Some y ∨ a x = None"
using Cons.prems(2)
by simp
ultimately show ?thesis
using map_add_Some_iff[of b a x y]
by blast
next
case m_is_some_y
then show ?thesis
proof (cases "a x = Some y")
case False
then obtain m where "m ∈ set ms" and "m x = Some y"
using m_is_some_y try0
by auto
thus ?thesis
by blast
qed simp
qed
moreover have "∀m' ∈ set ms. m' x = Some y ∨ m' x = None"
using Cons.prems(2)
by fastforce
ultimately show ?case using Cons.IH[where b="b ++ a"]
by simp
qed auto
lemma map_of_constant_assignments_defined_if:
assumes "∀(v, a) ∈ set l. ∀(v', a') ∈ set l. v ≠ v' ∨ a = a'"
and "(v, a) ∈ set l"
shows "map_of l v = Some a"
using assms
proof (induction l)
case (Cons x l)
thm Cons
then show ?case
proof (cases "x = (v, a)")
case False
have v_a_in_l: "(v, a) ∈ set l"
using Cons.prems(2) False
by fastforce
{
have "∀(v, a) ∈ set l. ∀(v', a') ∈ set l. v ≠ v' ∨ a = a'"
using Cons.prems(1)
by auto
hence "map_of l v = Some a"
using Cons.IH v_a_in_l
by linarith
} note ih = this
{
have "x ∈ set (x # l)"
by auto
hence "fst x ≠ v ∨ snd x = a"
using Cons.prems(1) v_a_in_l
by fastforce
} note nb = this
thus ?thesis
using ih nb
by (cases "fst x = v") fastforce+
qed simp
qed fastforce
end
Theory CNF_Supplement
theory CNF_Supplement
imports "Propositional_Proof_Systems.CNF_Formulas_Sema"
begin
fun is_literal_formula
where "is_literal_formula (Atom _) = True"
| "is_literal_formula (❙¬(Atom _)) = True"
| "is_literal_formula _ = False"
fun literal_formula_to_literal :: "'a formula ⇒ 'a literal"
where "literal_formula_to_literal (Atom a) = a⇧+"
| "literal_formula_to_literal (❙¬(Atom a)) = a¯"
lemma is_literal_formula_then_cnf_is_singleton_clause:
assumes "is_literal_formula f"
obtains C where "cnf f = { C }"
proof -
consider (f_is_positive_literal) "∃a. f = Atom a"
| (f_is_negative_literal) "∃a. f = ❙¬(Atom a)"
using assms is_literal_formula.elims(2)[of f]
by meson
then have "∃C. cnf f = { C }"
proof (cases)
case f_is_positive_literal
then obtain a where "f = Atom a"
by force
then have "cnf f = {{ a⇧+ }}"
by force
thus ?thesis
by simp
next
case f_is_negative_literal
then obtain a where "f = ❙¬(Atom a)"
by force
then have "cnf f = {{ a¯ }}"
by force
thus ?thesis
by simp
qed
thus ?thesis
using that
by presburger
qed
lemma literal_formula_to_literal_is_inverse_of_form_of_lit:
"literal_formula_to_literal (form_of_lit L) = L"
by (cases L, simp+)
lemma is_nnf_cnf:
assumes "is_cnf F"
shows "is_nnf F"
using assms
proof (induction F)
case (Or F1 F2)
have "is_disj (F1 ❙∨ F2)"
using Or.prems is_cnf.simps(5)
by simp
thus ?case
using disj_is_nnf
by blast
qed simp+
lemma cnf_of_literal_formula:
assumes "is_literal_formula f"
shows "cnf f = {{ literal_formula_to_literal f }}"
proof -
consider (f_is_positive_literal) "∃a. f = Atom a"
| (f_is_negative_literal) "∃a. f = (❙¬(Atom a))"
using assms is_literal_formula.elims(2)[of f "∃a. f = Atom a"]
is_literal_formula.elims(2)[of f "∃a. f = (❙¬(Atom a))"]
by blast
thus ?thesis
by(cases, force+)
qed
lemma is_cnf_foldr_and_if:
assumes "∀f ∈ set fs. is_cnf f"
shows "is_cnf (foldr (❙∧) fs (❙¬⊥))"
using assms
proof (induction fs)
case (Cons f fs)
have "foldr (❙∧) (f # fs) (❙¬⊥) = f ❙∧ (foldr (❙∧) fs (❙¬⊥))"
by simp
moreover {
have "∀f ∈ set fs. is_cnf f"
using Cons.prems
by force
hence "is_cnf (foldr (❙∧) fs (❙¬⊥))"
using Cons.IH
by blast
}
moreover have "is_cnf f"
using Cons.prems
by simp
ultimately show ?case
by simp
qed simp
end
Theory CNF_Semantics_Supplement
theory CNF_Semantics_Supplement
imports "Propositional_Proof_Systems.CNF_Formulas_Sema" "CNF_Supplement"
begin
lemma not_model_if_exists_unmodeled_singleton_clause:
assumes "is_cnf F"
and "{L} ∈ cnf F"
and "¬lit_semantics ν L"
shows "¬ν ⊨ F"
proof (rule ccontr)
assume "¬¬ν ⊨ F"
then have a: "ν ⊨ F"
by blast
moreover have "is_nnf F"
using is_nnf_cnf[OF assms(1)]
by simp
moreover {
let ?C = "{L}"
have "¬(∃L'. L' ∈ ?C ∧ lit_semantics ν L')"
using assms(3)
by fast
then have "¬(∀C ∈ cnf F. ∃L. L ∈ C ∧ lit_semantics ν L)"
using assms(2)
by blast
hence "¬cnf_semantics ν (cnf F)"
unfolding cnf_semantics_def clause_semantics_def
by fast
}
ultimately have "¬ ν ⊨ F"
using cnf_semantics
by blast
thus False
using a
by blast
qed
corollary model_then_all_singleton_clauses_modelled:
assumes "is_cnf F"
and "{L} ∈ cnf F"
and "ν ⊨ F"
shows "lit_semantics ν L"
using not_model_if_exists_unmodeled_singleton_clause[OF assms(1, 2)] assms(3)
by blast
lemma model_for_cnf_is_model_of_all_subsets:
assumes "cnf_semantics ν ℱ"
and "ℱ' ⊆ ℱ"
shows "cnf_semantics ν ℱ'"
proof -
{
fix C
assume "C ∈ ℱ'"
then have "C ∈ ℱ"
using assms(2)
by blast
then have "clause_semantics ν C"
using assms(1)
unfolding cnf_semantics_def
by blast
}
thus ?thesis
unfolding cnf_semantics_def
by blast
qed
lemma cnf_semantics_monotonous_in_cnf_subsets_if:
assumes "𝒜 ⊨ Φ"
and "is_cnf Φ"
and "cnf Φ' ⊆ cnf Φ"
shows "cnf_semantics 𝒜 (cnf Φ')"
proof -
{
have "is_nnf Φ"
using is_nnf_cnf[OF assms(2)].
hence "cnf_semantics 𝒜 (cnf Φ)"
using cnf_semantics assms(1)
by blast
}
thus ?thesis
using model_for_cnf_is_model_of_all_subsets[OF _ assms(3)]
by simp
qed
corollary modelling_relation_monotonous_in_cnf_subsets_if:
assumes "𝒜 ⊨ Φ"
and "is_cnf Φ"
and "is_cnf Φ'"
and "cnf Φ' ⊆ cnf Φ"
shows "𝒜 ⊨ Φ'"
proof -
have "cnf_semantics 𝒜 (cnf Φ')"
using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(1, 2, 4)].
thus ?thesis
using cnf_semantics is_nnf_cnf[OF assms(3)]
by blast
qed
lemma lit_semantics_reducible_to_subset_if:
assumes "C' ⊆ C"
and "∀L ∈ C'. ¬lit_semantics 𝒜 L"
shows "clause_semantics 𝒜 C = clause_semantics 𝒜 (C - C')"
unfolding clause_semantics_def
using assms
by fast
end
Theory State_Variable_Representation
theory State_Variable_Representation
imports Main "Propositional_Proof_Systems.Formulas" "Propositional_Proof_Systems.Sema"
"Propositional_Proof_Systems.CNF"
begin
section "State-Variable Representation"
text ‹ Moving on to the Isabelle implementation of state-variable representation, we
first add a more concrete representation of states using Isabelle maps. To this end, we add a
type synonym \isaname{state} for maps of variables to values.
Since maps can be conveniently constructed from lists of
assignments---i.e. pairs ‹(v, a) :: 'variable × 'domain›---we also add a corresponding type
synonym \isaname{assignment}. ›
type_synonym ('variable, 'domain) state = "'variable ⇀ 'domain"
type_synonym ('variable, 'domain) assignment = "'variable × 'domain"
text ‹ Effects and effect condition (see \autoref{sub:state-variable-representation}) are
implemented in a straight forward manner using a datatype with constructors for each effect type.›
type_synonym ('variable, 'domain) Effect = "('variable × 'domain) list"
end
Theory STRIPS_Representation
theory STRIPS_Representation
imports State_Variable_Representation
begin
section "STRIPS Representation"
type_synonym ('variable) strips_state = "('variable, bool) state"
text ‹ We start by declaring a \isakeyword{record} for STRIPS operators.
This which allows us to define a data type and automatically generated selector operations.
\footnote{For the full reference on records see \cite[11.6, pp.260-265]{wenzel--2018}}
The record specification given below closely resembles the canonical representation of
STRIPS operators with fields corresponding to precondition, add effects as well as delete effects.›
record ('variable) strips_operator =
precondition_of :: "'variable list"
add_effects_of :: "'variable list"
delete_effects_of :: "'variable list"
abbreviation operator_for
:: "'variable list ⇒ 'variable list ⇒ 'variable list ⇒ 'variable strips_operator"
where "operator_for pre add delete ≡ ⦇
precondition_of = pre
, add_effects_of = add
, delete_effects_of = delete ⦈"
definition to_precondition
:: "'variable strips_operator ⇒ ('variable, bool) assignment list"
where "to_precondition op ≡ map (λv. (v, True)) (precondition_of op)"
definition to_effect
:: "'variable strips_operator ⇒ ('variable, bool) Effect"
where "to_effect op = [(v⇩a, True). v⇩a ← add_effects_of op] @ [(v⇩d, False). v⇩d ← delete_effects_of op]"
text ‹ Similar to the operator definition, we use a record to represent STRIPS problems and specify
fields for the variables, operators, as well as the initial and goal state. ›
record ('variable) strips_problem =
variables_of :: "'variable list" ("(_⇩𝒱)" [1000] 999)
operators_of :: "'variable strips_operator list" ("(_⇩𝒪)" [1000] 999)
initial_of :: "'variable strips_state" ("(_⇩I)" [1000] 999)
goal_of :: "'variable strips_state" ("(_⇩G)" [1000] 999)
value "stop"
abbreviation problem_for
:: "'variable list
⇒ 'variable strips_operator list
⇒ 'variable strips_state
⇒ 'variable strips_state
⇒ ('variable) strips_problem"
where "problem_for vs ops I gs ≡ ⦇
variables_of = vs
, operators_of = ops
, initial_of = I
, goal_of = gs ⦈"
type_synonym ('variable) strips_plan = "'variable strips_operator list"
type_synonym ('variable) strips_parallel_plan = "'variable strips_operator list list"
definition is_valid_operator_strips
:: "'variable strips_problem ⇒ 'variable strips_operator ⇒ bool"
where "is_valid_operator_strips Π op ≡ let
vs = variables_of Π
; pre = precondition_of op
; add = add_effects_of op
; del = delete_effects_of op
in list_all (λv. ListMem v vs) pre
∧ list_all (λv. ListMem v vs) add
∧ list_all (λv. ListMem v vs) del
∧ list_all (λv. ¬ListMem v del) add
∧ list_all (λv. ¬ListMem v add) del"
definition "is_valid_problem_strips Π
≡ let ops = operators_of Π
; vs = variables_of Π
; I = initial_of Π
; G = goal_of Π
in list_all (is_valid_operator_strips Π) ops
∧ (∀v. I v ≠ None ⟷ ListMem v vs)
∧ (∀v. G v ≠ None ⟶ ListMem v vs)"
definition is_operator_applicable_in
:: "'variable strips_state ⇒ 'variable strips_operator ⇒ bool"
where "is_operator_applicable_in s op ≡ let p = precondition_of op in
list_all (λv. s v = Some True) p"
definition effect__strips
:: "'variable strips_operator ⇒ ('variable, bool) Effect"
where "effect__strips op
=
map (λv. (v, True)) (add_effects_of op)
@ map (λv. (v, False)) (delete_effects_of op)"
definition effect_to_assignments
where "effect_to_assignments op ≡ effect__strips op"
text ‹ As discussed in \autoref{sub:serial-sas-plus-and-parallel-strips}, the effect of
a STRIPS operator can be normalized to a conjunction of atomic effects. We can therefore construct
the successor state by simply converting the list of add effects to assignments to \<^term>‹True› resp.
converting the list of delete effect to a list of assignments to \<^term>‹False› and then adding the
map corresponding to the assignments to the given state \<^term>‹s› as shown below in definition
\ref{isadef:operator-execution-strips}.
\footnote{Function \path{effect_to_assignments} converts the operator effect to a list of
assignments. }›
definition execute_operator
:: "'variable strips_state
⇒ 'variable strips_operator
⇒ 'variable strips_state" (infixl "⪢" 52)
where "execute_operator s op
≡ s ++ map_of (effect_to_assignments op)"
end
Theory STRIPS_Semantics
theory STRIPS_Semantics
imports "STRIPS_Representation"
"List_Supplement"
"Map_Supplement"
begin
section "STRIPS Semantics"
text ‹ Having provided a concrete implementation of STRIPS and a corresponding locale ‹strips›, we
can now continue to define the semantics of serial and parallel STRIPS plan execution (see
\autoref{sub:serial-sas-plus-and-parallel-strips} and
\autoref{sub:parallel-sas-plus-and-parallel-strips}). ›
subsection "Serial Plan Execution Semantics"
text ‹ Serial plan execution is defined by primitive recursion on the plan.
Definition \autoref{isadef:execute_serial_plan} returns the given state if the state argument does
note satisfy the precondition of the next operator in the plan.
Otherwise it executes the rest of the plan on the successor state \<^term>‹execute_operator s op› of
the given state and operator. ›
primrec execute_serial_plan
where "execute_serial_plan s [] = s"
| "execute_serial_plan s (op # ops)
= (if is_operator_applicable_in s op
then execute_serial_plan (execute_operator s op) ops
else s
)"
text ‹ Analogously, a STRIPS trace either returns the singleton list containing only the given
state in case the precondition of the next operator in the plan is not satisfied. Otherwise, the
given state is prepended to trace of the rest of the plan for the successor state of executing the
next operator on the given state. ›
fun trace_serial_plan_strips
:: "'variable strips_state ⇒ 'variable strips_plan ⇒ 'variable strips_state list"
where "trace_serial_plan_strips s [] = [s]"
| "trace_serial_plan_strips s (op # ops)
= s # (if is_operator_applicable_in s op
then trace_serial_plan_strips (execute_operator s op) ops
else [])"
text ‹ Finally, a serial solution is a plan which transforms a given problems initial state into
its goal state and for which all operators are elements of the problem's operator list. ›
definition is_serial_solution_for_problem
where "is_serial_solution_for_problem Π π
≡ (goal_of Π) ⊆⇩m execute_serial_plan (initial_of Π) π
∧ list_all (λop. ListMem op (operators_of Π)) π"
lemma is_valid_problem_strips_initial_of_dom:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
shows "dom ((Π)⇩I) = set ((Π)⇩𝒱)"
proof -
{
let ?I = "strips_problem.initial_of Π"
let ?vs = "strips_problem.variables_of Π"
fix v
have "?I v ≠ None ⟷ ListMem v ?vs"
using assms(1)
unfolding is_valid_problem_strips_def
by meson
hence "v ∈ dom ?I ⟷ v ∈ set ?vs"
using ListMem_iff
by fast
}
thus ?thesis
by auto
qed
lemma is_valid_problem_dom_of_goal_state_is:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
shows "dom ((Π)⇩G) ⊆ set ((Π)⇩𝒱)"
proof -
let ?vs = "strips_problem.variables_of Π"
let ?G = "strips_problem.goal_of Π"
have nb: "∀v. ?G v ≠ None ⟶ ListMem v ?vs"
using assms(1)
unfolding is_valid_problem_strips_def
by meson
{
fix v
assume "v ∈ dom ?G"
then have "?G v ≠ None"
by blast
hence "v ∈ set ?vs"
using nb
unfolding ListMem_iff
by blast
}
thus ?thesis
by auto
qed
lemma is_valid_problem_strips_operator_variable_sets:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "op ∈ set ((Π)⇩𝒪)"
shows "set (precondition_of op) ⊆ set ((Π)⇩𝒱)"
and "set (add_effects_of op) ⊆ set ((Π)⇩𝒱)"
and "set (delete_effects_of op) ⊆ set ((Π)⇩𝒱)"
and "disjnt (set (add_effects_of op)) (set (delete_effects_of op))"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
have "list_all (is_valid_operator_strips Π) ?ops"
using assms(1)
unfolding is_valid_problem_strips_def
by meson
moreover have "∀v ∈ set (precondition_of op). v ∈ set ((Π)⇩𝒱)"
and "∀v ∈ set (add_effects_of op). v ∈ set ((Π)⇩𝒱)"
and "∀v ∈ set (delete_effects_of op). v ∈ set ((Π)⇩𝒱)"
and "∀v ∈ set (add_effects_of op). v ∉ set (delete_effects_of op)"
and "∀v ∈ set (delete_effects_of op). v ∉ set (add_effects_of op)"
using assms(2) calculation
unfolding is_valid_operator_strips_def list_all_iff Let_def ListMem_iff
using variables_of_def
by auto+
ultimately show "set (precondition_of op) ⊆ set ((Π)⇩𝒱)"
and "set (add_effects_of op) ⊆ set ((Π)⇩𝒱)"
and "set (delete_effects_of op) ⊆ set ((Π)⇩𝒱)"
and "disjnt (set (add_effects_of op)) (set (delete_effects_of op))"
unfolding disjnt_def
by fast+
qed
lemma effect_to_assignments_i:
assumes "as = effect_to_assignments op"
shows "as = (map (λv. (v, True)) (add_effects_of op)
@ map (λv. (v, False)) (delete_effects_of op))"
using assms
unfolding effect_to_assignments_def effect__strips_def
by auto
lemma effect_to_assignments_ii:
assumes "as = effect_to_assignments op"
obtains as⇩1 as⇩2
where "as = as⇩1 @ as⇩2"
and "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
by (simp add: assms effect__strips_def effect_to_assignments_def)
lemma effect_to_assignments_iii_a:
fixes v
assumes "v ∈ set (add_effects_of op)"
and "as = effect_to_assignments op"
obtains a where "a ∈ set as" "a = (v, True)"
proof -
let ?add_assignments = "(λv. (v, True)) ` set (add_effects_of op)"
let ?delete_assignments = "(λv. (v, False)) ` set (delete_effects_of op)"
obtain as⇩1 as⇩2
where a1: "as = as⇩1 @ as⇩2"
and a2: "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and a3: "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using assms(2) effect_to_assignments_ii
by blast
then have b: "set as
= ?add_assignments ∪ ?delete_assignments"
by auto
{
from b have "?add_assignments ⊆ set as"
by blast
moreover have "{(v, True)} ⊆ ?add_assignments"
using assms(1) a2
by blast
ultimately have "∃a. a ∈ set as ∧ a = (v, True)"
by blast
}
then show ?thesis
using that
by blast
qed
lemma effect_to_assignments_iii_b:
fixes v
assumes "v ∈ set (delete_effects_of op)"
and "as = effect_to_assignments op"
obtains a where "a ∈ set as" "a = (v, False)"
proof -
let ?add_assignments = "(λv. (v, True)) ` set (add_effects_of op)"
let ?delete_assignments = "(λv. (v, False)) ` set (delete_effects_of op)"
obtain as⇩1 as⇩2
where a1: "as = as⇩1 @ as⇩2"
and a2: "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and a3: "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using assms(2) effect_to_assignments_ii
by blast
then have b: "set as
= ?add_assignments ∪ ?delete_assignments"
by auto
{
from b have "?delete_assignments ⊆ set as"
by blast
moreover have "{(v, False)} ⊆ ?delete_assignments"
using assms(1) a2
by blast
ultimately have "∃a. a ∈ set as ∧ a = (v, False)"
by blast
}
then show ?thesis
using that
by blast
qed
lemma effect__strips_i:
fixes op
assumes "e = effect__strips op"
obtains es⇩1 es⇩2
where "e = (es⇩1 @ es⇩2)"
and "es⇩1 = map (λv. (v, True)) (add_effects_of op)"
and "es⇩2 = map (λv. (v, False)) (delete_effects_of op)"
proof -
obtain es⇩1 es⇩2 where a: "e = (es⇩1 @ es⇩2)"
and b: "es⇩1 = map (λv. (v, True)) (add_effects_of op)"
and c: "es⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using assms(1)
unfolding effect__strips_def
by blast
then show ?thesis
using that
by force
qed
lemma effect__strips_ii:
fixes op
assumes "e = ConjunctiveEffect (es⇩1 @ es⇩2)"
and "es⇩1 = map (λv. (v, True)) (add_effects_of op)"
and "es⇩2 = map (λv. (v, False)) (delete_effects_of op)"
shows "∀v ∈ set (add_effects_of op). (∃e' ∈ set es⇩1. e' = (v, True))"
and "∀v ∈ set (delete_effects_of op). (∃e' ∈ set es⇩2. e' = (v, False))"
proof
fix v
{
assume a: "v ∈ set (add_effects_of op)"
have "set es⇩1 = (λv. (v, True)) ` set (add_effects_of op)"
using assms(2) List.set_map
by auto
then obtain e'
where "e' ∈ set es⇩1"
and "e' = (λv. (v, True)) v"
using a
by blast
then have "∃e' ∈ set es⇩1. e' = (v, True)"
by blast
}
thus "v ∈ set (add_effects_of op) ⟹ ∃e' ∈ set es⇩1. e' = (v, True)"
by fast
next
{
fix v
assume a: "v ∈ set (delete_effects_of op)"
have "set es⇩2 = (λv. (v, False)) ` set (delete_effects_of op)"
using assms(3) List.set_map
by force
then obtain e''
where "e'' ∈ set es⇩2"
and "e'' = (λv. (v, False)) v"
using a
by blast
then have "∃e'' ∈ set es⇩2. e'' = (v, False)"
by blast
}
thus "∀v∈set (delete_effects_of op). ∃e'∈set es⇩2. e' = (v, False)"
by fast
qed
lemma map_of_constant_assignments_dom:
assumes "m = map_of (map (λv. (v, d)) vs)"
shows "dom m = set vs"
proof -
let ?vs' = "map (λv. (v, d)) vs"
have "dom m = fst ` set ?vs'"
using assms(1) dom_map_of_conv_image_fst
by metis
moreover have "fst ` set ?vs' = set vs"
by force
ultimately show ?thesis
by argo
qed
lemma effect__strips_iii_a:
assumes "s' = (s ⪢ op)"
shows "⋀v. v ∈ set (add_effects_of op) ⟹ s' v = Some True"
proof -
fix v
assume a: "v ∈ set (add_effects_of op)"
let ?as = "effect_to_assignments op"
obtain as⇩1 as⇩2 where b: "?as = as⇩1 @ as⇩2"
and c: "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using effect_to_assignments_ii
by blast
have d: "map_of ?as = map_of as⇩2 ++ map_of as⇩1"
using b Map.map_of_append
by auto
{
let ?vs = "add_effects_of op"
have "?vs ≠ []"
using a
by force
then have "dom (map_of as⇩1) = set (add_effects_of op)"
using c map_of_constant_assignments_dom
by metis
then have "v ∈ dom (map_of as⇩1)"
using a
by blast
then have "map_of ?as v = map_of as⇩1 v"
using d
by force
} moreover {
let ?f = "λ_. True"
from c have "map_of as⇩1 = (Some ∘ ?f) |` (set (add_effects_of op))"
using map_of_map_restrict
by fast
then have "map_of as⇩1 v = Some True"
using a
by auto
}
moreover have "s' = s ++ map_of as⇩2 ++ map_of as⇩1"
using assms(1)
unfolding execute_operator_def
using b
by simp
ultimately show "s' v = Some True"
by simp
qed
lemma effect__strips_iii_b:
assumes "s' = (s ⪢ op)"
shows "⋀v. v ∈ set (delete_effects_of op) ∧ v ∉ set (add_effects_of op) ⟹ s' v = Some False"
proof (auto)
fix v
assume a1: "v ∉ set (add_effects_of op)" and a2: "v ∈ set (delete_effects_of op)"
let ?as = "effect_to_assignments op"
obtain as⇩1 as⇩2 where b: "?as = as⇩1 @ as⇩2"
and c: "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and d: "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using effect_to_assignments_ii
by blast
have e: "map_of ?as = map_of as⇩2 ++ map_of as⇩1"
using b Map.map_of_append
by auto
{
have "dom (map_of as⇩1) = set (add_effects_of op)"
using c map_of_constant_assignments_dom
by metis
then have "v ∉ dom (map_of as⇩1)"
using a1
by blast
} note f = this
{
let ?vs = "delete_effects_of op"
have "?vs ≠ []"
using a2
by force
then have "dom (map_of as⇩2) = set ?vs"
using d map_of_constant_assignments_dom
by metis
} note g = this
{
have "s' = s ++ map_of as⇩2 ++ map_of as⇩1"
using assms(1)
unfolding execute_operator_def
using b
by simp
thm f map_add_dom_app_simps(3)[OF f, of "s ++ map_of as⇩2"]
moreover have "s' v = (s ++ map_of as⇩2) v"
using calculation map_add_dom_app_simps(3)[OF f, of "s ++ map_of as⇩2"]
by blast
moreover have "v ∈ dom (map_of as⇩2)"
using a2 g
by argo
ultimately have "s' v = map_of as⇩2 v"
by fastforce
}
moreover
{
let ?f = "λ_. False"
from d have "map_of as⇩2 = (Some ∘ ?f) |` (set (delete_effects_of op))"
using map_of_map_restrict
by fast
then have "map_of as⇩2 v = Some False"
using a2
by force
}
ultimately show " s' v = Some False"
by argo
qed
lemma effect__strips_iii_c:
assumes "s' = (s ⪢ op)"
shows "⋀v. v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op) ⟹ s' v = s v"
proof (auto)
fix v
assume a1: "v ∉ set (add_effects_of op)" and a2: "v ∉ set (delete_effects_of op)"
let ?as = "effect_to_assignments op"
obtain as⇩1 as⇩2 where b: "?as = as⇩1 @ as⇩2"
and c: "as⇩1 = map (λv. (v, True)) (add_effects_of op)"
and d: "as⇩2 = map (λv. (v, False)) (delete_effects_of op)"
using effect_to_assignments_ii
by blast
have e: "map_of ?as = map_of as⇩2 ++ map_of as⇩1"
using b Map.map_of_append
by auto
{
have "dom (map_of as⇩1) = set (add_effects_of op)"
using c map_of_constant_assignments_dom
by metis
then have "v ∉ dom (map_of as⇩1)"
using a1
by blast
} moreover {
have "dom (map_of as⇩2) = set (delete_effects_of op)"
using d map_of_constant_assignments_dom
by metis
then have "v ∉ dom (map_of as⇩2)"
using a2
by blast
}
ultimately show "s' v = s v"
using assms(1)
unfolding execute_operator_def
by (simp add: b map_add_dom_app_simps(3))
qed
text ‹The following theorem combines three preceding sublemmas which show
that the following properties hold for the successor state ‹s' ≡ execute_operator op s›
obtained by executing an operator ‹op› in a state ‹s›:
\footnote{Lemmas \path{effect__strips_iii_a}, \path{effect__strips_iii_b}, and
\path{effect__strips_iii_c} (not shown).}
\begin{itemize}
\item every add effect is satisfied in ‹s'› (sublemma \isaname{effect__strips_iii_a}); and,
\item every delete effect that is not also an add effect is not satisfied in ‹s'› (sublemma
\isaname{effect__strips_iii_b}); and finally
\item the state remains unchanged---i.e. ‹s' v = s v›---for all variables which are neither an
add effect nor a delete effect.
\end{itemize} ›
theorem operator_effect__strips:
assumes "s' = (s ⪢ op)"
shows
"⋀v.
v ∈ set (add_effects_of op)
⟹ s' v = Some True"
and "⋀v.
v ∉ set (add_effects_of op) ∧ v ∈ set (delete_effects_of op)
⟹ s' v = Some False"
and "⋀v.
v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)
⟹ s' v = s v"
proof (auto)
show "⋀v.
v ∈ set (add_effects_of op)
⟹ s' v = Some True"
using assms effect__strips_iii_a
by fast
next
show "⋀v.
v ∉ set (add_effects_of op)
⟹ v ∈ set (delete_effects_of op)
⟹ s' v = Some False"
using assms effect__strips_iii_b
by fast
next
show "⋀v.
v ∉ set (add_effects_of op)
⟹ v ∉ set (delete_effects_of op)
⟹ s' v = s v"
using assms effect__strips_iii_c
by metis
qed
subsection "Parallel Plan Semantics"
definition "are_all_operators_applicable s ops
≡ list_all (λop. is_operator_applicable_in s op) ops"
definition "are_operator_effects_consistent op⇩1 op⇩2 ≡ let
add⇩1 = add_effects_of op⇩1
; add⇩2 = add_effects_of op⇩2
; del⇩1 = delete_effects_of op⇩1
; del⇩2 = delete_effects_of op⇩2
in ¬list_ex (λv. list_ex ((=) v) del⇩2) add⇩1 ∧ ¬list_ex (λv. list_ex ((=) v) add⇩2) del⇩1"
definition "are_all_operator_effects_consistent ops ≡
list_all (λop. list_all (are_operator_effects_consistent op) ops) ops"
definition execute_parallel_operator
:: "'variable strips_state
⇒ 'variable strips_operator list
⇒ 'variable strips_state"
where "execute_parallel_operator s ops
≡ foldl (++) s (map (map_of ∘ effect_to_assignments) ops)"
text ‹ The parallel STRIPS execution semantics is defined in similar way as the serial STRIPS
execution semantics. However, the applicability test is lifted to parallel operators and we
additionally test for operator consistency (which was unecessary in the serial case). ›
fun execute_parallel_plan
:: "'variable strips_state
⇒ 'variable strips_parallel_plan
⇒ 'variable strips_state"
where "execute_parallel_plan s [] = s"
| "execute_parallel_plan s (ops # opss) = (if
are_all_operators_applicable s ops
∧ are_all_operator_effects_consistent ops
then execute_parallel_plan (execute_parallel_operator s ops) opss
else s)"
definition "are_operators_interfering op⇩1 op⇩2
≡ list_ex (λv. list_ex ((=) v) (delete_effects_of op⇩1)) (precondition_of op⇩2)
∨ list_ex (λv. list_ex ((=) v) (precondition_of op⇩1)) (delete_effects_of op⇩2)"
primrec are_all_operators_non_interfering
:: "'variable strips_operator list ⇒ bool"
where "are_all_operators_non_interfering [] = True"
| "are_all_operators_non_interfering (op # ops)
= (list_all (λop'. ¬are_operators_interfering op op') ops
∧ are_all_operators_non_interfering ops)"
text ‹ Since traces mirror the execution semantics, the same is true for the definition of
parallel STRIPS plan traces. ›
fun trace_parallel_plan_strips
:: "'variable strips_state ⇒ 'variable strips_parallel_plan ⇒ 'variable strips_state list"
where "trace_parallel_plan_strips s [] = [s]"
| "trace_parallel_plan_strips s (ops # opss) = s # (if
are_all_operators_applicable s ops
∧ are_all_operator_effects_consistent ops
then trace_parallel_plan_strips (execute_parallel_operator s ops) opss
else [])"
text ‹ Similarly, the definition of parallel solutions requires that the parallel execution
semantics transforms the initial problem into the goal state of the problem and that every
operator of every parallel operator in the parallel plan is an operator that is defined in the
problem description. ›
definition is_parallel_solution_for_problem
where "is_parallel_solution_for_problem Π π
≡ (strips_problem.goal_of Π) ⊆⇩m execute_parallel_plan
(strips_problem.initial_of Π) π
∧ list_all (λops. list_all (λop.
ListMem op (strips_problem.operators_of Π)) ops) π"
lemma are_all_operators_applicable_set:
"are_all_operators_applicable s ops
⟷ (∀op ∈ set ops. ∀v ∈ set (precondition_of op). s v = Some True)"
unfolding are_all_operators_applicable_def
STRIPS_Representation.is_operator_applicable_in_def list_all_iff
by presburger
lemma are_all_operators_applicable_cons:
assumes "are_all_operators_applicable s (op # ops)"
shows "is_operator_applicable_in s op"
and "are_all_operators_applicable s ops"
proof -
from assms have a: "list_all (λop. is_operator_applicable_in s op) (op # ops)"
unfolding are_all_operators_applicable_def is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def
by blast
then have "is_operator_applicable_in s op"
by fastforce
moreover {
from a have "list_all (λop. is_operator_applicable_in s op) ops"
by simp
then have "are_all_operators_applicable s ops"
using are_all_operators_applicable_def is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def
by blast
}
ultimately show "is_operator_applicable_in s op"
and "are_all_operators_applicable s ops"
by fast+
qed
lemma are_operator_effects_consistent_set:
assumes "op⇩1 ∈ set ops"
and "op⇩2 ∈ set ops"
shows "are_operator_effects_consistent op⇩1 op⇩2
= (set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {}
∧ set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {})"
proof -
have "(¬list_ex (λv. list_ex ((=) v) (delete_effects_of op⇩2)) (add_effects_of op⇩1))
= (set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {})"
using list_ex_intersection[of "delete_effects_of op⇩2" "add_effects_of op⇩1"]
by meson
moreover have "(¬list_ex (λv. list_ex ((=) v) (add_effects_of op⇩2)) (delete_effects_of op⇩1))
= (set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {})"
using list_ex_intersection[of "add_effects_of op⇩2" "delete_effects_of op⇩1"]
by meson
ultimately show "are_operator_effects_consistent op⇩1 op⇩2
= (set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {}
∧ set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {})"
unfolding are_operator_effects_consistent_def
by presburger
qed
lemma are_all_operator_effects_consistent_set:
"are_all_operator_effects_consistent ops
⟷ (∀op⇩1 ∈ set ops. ∀op⇩2 ∈ set ops.
(set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {})
∧ (set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {}))"
proof -
{
fix op⇩1 op⇩2
assume "op⇩1 ∈ set ops" and "op⇩2 ∈ set ops"
hence "are_operator_effects_consistent op⇩1 op⇩2
= (set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {}
∧ set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {})"
using are_operator_effects_consistent_set[of op⇩1 ops op⇩2]
by fast
}
thus ?thesis
unfolding are_all_operator_effects_consistent_def list_all_iff
by force
qed
lemma are_all_effects_consistent_tail:
assumes "are_all_operator_effects_consistent (op # ops)"
shows "are_all_operator_effects_consistent ops"
proof -
from assms
have a: "list_all (λop'. list_all (are_operator_effects_consistent op')
(Cons op ops)) (Cons op ops)"
unfolding are_all_operator_effects_consistent_def
by blast
then have b_1: "list_all (are_operator_effects_consistent op) (op # ops)"
and b_2: "list_all (λop'. list_all (are_operator_effects_consistent op') (op # ops)) ops"
by force+
then have "list_all (are_operator_effects_consistent op) ops"
by simp
moreover
{
{
fix z
assume "z ∈ set (Cons op ops)"
and "list_all (are_operator_effects_consistent z) (op # ops)"
then have "list_all (are_operator_effects_consistent z) ops"
by auto
}
then have "list_all (λop'. list_all (are_operator_effects_consistent op') ops) ops"
using list.pred_mono_strong[of
"(λop'. list_all (are_operator_effects_consistent op') (op # ops))"
"Cons op ops" "(λop'. list_all (are_operator_effects_consistent op') ops)"
] a
by fastforce
}
ultimately have "list_all (are_operator_effects_consistent op) ops
∧ list_all (λop'. list_all (are_operator_effects_consistent op') ops) ops"
by blast
then show ?thesis
using are_all_operator_effects_consistent_def
by fast
qed
lemma are_all_operators_non_interfering_tail:
assumes "are_all_operators_non_interfering (op # ops)"
shows "are_all_operators_non_interfering ops"
using assms
unfolding are_all_operators_non_interfering_def
by simp
lemma are_operators_interfering_symmetric:
assumes "are_operators_interfering op⇩1 op⇩2"
shows "are_operators_interfering op⇩2 op⇩1"
using assms
unfolding are_operators_interfering_def list_ex_iff
by fast
lemma are_all_operators_non_interfering_set_contains_no_distinct_interfering_operator_pairs:
assumes "are_all_operators_non_interfering ops"
and "are_operators_interfering op⇩1 op⇩2"
and "op⇩1 ≠ op⇩2"
shows "op⇩1 ∉ set ops ∨ op⇩2 ∉ set ops"
using assms
proof (induction ops)
case (Cons op ops)
thm Cons.IH[OF _ Cons.prems(2, 3)]
have nb⇩1: "∀op' ∈ set ops. ¬are_operators_interfering op op'"
and nb⇩2: "are_all_operators_non_interfering ops"
using Cons.prems(1)
unfolding are_all_operators_non_interfering.simps(2) list_all_iff
by blast+
then consider (A) "op = op⇩1"
| (B) "op = op⇩2"
| (C) "op ≠ op⇩1 ∧ op ≠ op⇩2"
by blast
thus ?case
proof (cases)
case A
{
assume "op⇩2 ∈ set (op # ops)"
then have "op⇩2 ∈ set ops"
using Cons.prems(3) A
by force
then have "¬are_operators_interfering op⇩1 op⇩2"
using nb⇩1 A
by fastforce
hence False
using Cons.prems(2)..
}
thus ?thesis
by blast
next
case B
{
assume "op⇩1 ∈ set (op # ops)"
then have "op⇩1 ∈ set ops"
using Cons.prems(3) B
by force
then have "¬are_operators_interfering op⇩1 op⇩2"
using nb⇩1 B are_operators_interfering_symmetric
by blast
hence False
using Cons.prems(2)..
}
thus ?thesis
by blast
next
case C
thus ?thesis
using Cons.IH[OF nb⇩2 Cons.prems(2, 3)]
by force
qed
qed simp
lemma execute_parallel_plan_precondition_cons_i:
fixes s :: "('variable, bool) state"
assumes "¬are_operators_interfering op op'"
and "is_operator_applicable_in s op"
and "is_operator_applicable_in s op'"
shows "is_operator_applicable_in (s ++ map_of (effect_to_assignments op)) op'"
proof -
let ?s' = "s ++ map_of (effect_to_assignments op)"
{
have a: "?s' = s ⪢ op"
by (simp add: execute_operator_def)
then have "⋀v. v ∈ set (add_effects_of op) ⟹ ?s' v = Some True"
and "⋀v. v ∉ set (add_effects_of op) ∧ v ∈ set (delete_effects_of op) ⟹ ?s' v = Some False"
and "⋀v. v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op) ⟹ ?s' v = s v"
using operator_effect__strips
by metis+
}
note a = this
{
fix v
assume α: "v ∈ set (precondition_of op')"
{
fix v
have "¬list_ex ((=) v) (delete_effects_of op)
= list_all (λv'. ¬v = v') (delete_effects_of op)"
using not_list_ex_equals_list_all_not[
where P="(=) v" and xs="delete_effects_of op"]
by blast
} moreover {
from assms(1)
have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (precondition_of op')"
unfolding are_operators_interfering_def
by blast
then have "list_all (λv. ¬list_ex ((=) v) (delete_effects_of op)) (precondition_of op')"
using not_list_ex_equals_list_all_not[
where P="λv. list_ex ((=) v) (delete_effects_of op)" and xs="precondition_of op'"]
by blast
}
ultimately have β:
"list_all (λv. list_all (λv'. ¬v = v') (delete_effects_of op)) (precondition_of op')"
by presburger
moreover {
fix v
have "list_all (λv'. ¬v = v') (delete_effects_of op)
= (∀v' ∈ set (delete_effects_of op). ¬v = v')"
using list_all_iff [where P="λv'. ¬v = v'" and x="delete_effects_of op"]
.
}
ultimately have "∀v ∈ set (precondition_of op'). ∀v' ∈ set (delete_effects_of op). ¬v = v'"
using β list_all_iff[
where P="λv. list_all (λv'. ¬v = v') (delete_effects_of op)"
and x="precondition_of op'"]
by presburger
then have "v ∉ set (delete_effects_of op)"
using α
by fast
}
note b = this
{
fix v
assume a: "v ∈ set (precondition_of op')"
have "list_all (λv. s v = Some True) (precondition_of op')"
using assms(3)
unfolding is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def
by presburger
then have "∀v ∈ set (precondition_of op'). s v = Some True"
using list_all_iff[where P="λv. s v = Some True" and x="precondition_of op'"]
by blast
then have "s v = Some True"
using a
by blast
}
note c = this
{
fix v
assume d: "v ∈ set (precondition_of op')"
then have "?s' v = Some True"
proof (cases "v ∈ set (add_effects_of op)")
case True
then show ?thesis
using a
by blast
next
case e: False
then show ?thesis
proof (cases "v ∈ set (delete_effects_of op)")
case True
then show ?thesis
using assms(1) b d
by fast
next
case False
then have "?s' v = s v"
using a e
by blast
then show ?thesis
using c d
by presburger
qed
qed
}
then have "list_all (λv. ?s' v = Some True) (precondition_of op')"
using list_all_iff[where P="λv. ?s' v = Some True" and x="precondition_of op'"]
by blast
then show ?thesis
unfolding is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def
by auto
qed
lemma execute_parallel_plan_precondition_cons:
fixes a :: "'variable strips_operator"
assumes "are_all_operators_applicable s (a # ops)"
and "are_all_operator_effects_consistent (a # ops)"
and "are_all_operators_non_interfering (a # ops)"
shows "are_all_operators_applicable (s ++ map_of (effect_to_assignments a)) ops"
and "are_all_operator_effects_consistent ops"
and "are_all_operators_non_interfering ops"
using are_all_effects_consistent_tail[OF assms(2)]
are_all_operators_non_interfering_tail[OF assms(3)]
proof -
let ?s' = "s ++ map_of (effect_to_assignments a)"
have nb⇩1: "∀op ∈ set (a # ops). is_operator_applicable_in s op"
using assms(1) are_all_operators_applicable_set
unfolding are_all_operators_applicable_def is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def list_all_iff
by blast
have nb⇩2: "∀op ∈ set ops. ¬are_operators_interfering a op"
using assms(3)
unfolding are_all_operators_non_interfering_def list_all_iff
by simp
have nb⇩3: "is_operator_applicable_in s a"
using assms(1) are_all_operators_applicable_set
unfolding are_all_operators_applicable_def is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def list_all_iff
by force
{
fix op
assume op_in_ops: "op ∈ set ops"
hence "is_operator_applicable_in ?s' op"
using execute_parallel_plan_precondition_cons_i[of a op] nb⇩1 nb⇩2 nb⇩3
by force
}
then show "are_all_operators_applicable ?s' ops"
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by blast
qed
lemma execute_parallel_operator_cons[simp]:
"execute_parallel_operator s (op # ops)
= execute_parallel_operator (s ++ map_of (effect_to_assignments op)) ops"
unfolding execute_parallel_operator_def
by simp
lemma execute_parallel_operator_cons_equals:
assumes "are_all_operators_applicable s (a # ops)"
and "are_all_operator_effects_consistent (a # ops)"
and "are_all_operators_non_interfering (a # ops)"
shows "execute_parallel_operator s (a # ops)
= execute_parallel_operator (s ++ map_of (effect_to_assignments a)) ops"
proof -
let ?s' = "s ++ map_of (effect_to_assignments a)"
{
from assms(1, 2)
have "execute_parallel_operator s (Cons a ops)
= foldl (++) s (map (map_of ∘ effect_to_assignments) (Cons a ops))"
unfolding execute_parallel_operator_def
by presburger
also have "… = foldl (++) (?s')
(map (map_of ∘ effect_to_assignments) ops)"
by auto
finally have "execute_parallel_operator s (Cons a ops)
= foldl (++) (?s')
(map (map_of ∘ effect_to_assignments) ops)"
using execute_parallel_operator_def
by blast
}
moreover have "execute_parallel_operator ?s' ops
= foldl (++) (s ++ (map_of ∘ effect_to_assignments) a)
(map (map_of ∘ effect_to_assignments) ops)"
by (simp add: execute_parallel_operator_def)
ultimately show ?thesis
by force
qed
corollary execute_parallel_operator_cons_equals_corollary:
assumes "are_all_operators_applicable s (a # ops)"
shows "execute_parallel_operator s (a # ops)
= execute_parallel_operator (s ⪢ a) ops"
proof -
let ?s' = "s ++ map_of (effect_to_assignments a)"
from assms
have "execute_parallel_operator s (a # ops)
= execute_parallel_operator (s ++ map_of (effect_to_assignments a)) ops"
using execute_parallel_operator_cons_equals
by simp
moreover have "?s' = s ⪢ a"
unfolding execute_operator_def
by simp
ultimately show ?thesis
by argo
qed
lemma effect_to_assignments_simp[simp]: "effect_to_assignments op
= map (λv. (v, True)) (add_effects_of op) @ map (λv. (v, False)) (delete_effects_of op)"
by (simp add: effect_to_assignments_i)
lemma effect_to_assignments_set_is[simp]:
"set (effect_to_assignments op) = { ((v, a), True) | v a. (v, a) ∈ set (add_effects_of op) }
∪ { ((v, a), False) | v a. (v, a) ∈ set (delete_effects_of op) }"
proof -
obtain as where "effect__strips op = as"
and "as = map (λv. (v, True)) (add_effects_of op)
@ map (λv. (v, False)) (delete_effects_of op)"
unfolding effect__strips_def
by blast
moreover have "as
= map (λv. (v, True)) (add_effects_of op) @ map (λv. (v, False)) (delete_effects_of op)"
using calculation(2)
unfolding map_append map_map comp_apply
by auto
moreover have "effect_to_assignments op = as"
unfolding effect_to_assignments_def calculation(1, 2)
by auto
ultimately show ?thesis
unfolding set_map
by auto
qed
corollary effect_to_assignments_construction_from_function_graph:
assumes "set (add_effects_of op) ∩ set (delete_effects_of op) = {}"
shows "effect_to_assignments op = map
(λv. (v, if ListMem v (add_effects_of op) then True else False))
(add_effects_of op @ delete_effects_of op)"
and "effect_to_assignments op = map
(λv. (v, if ListMem v (delete_effects_of op) then False else True))
(add_effects_of op @ delete_effects_of op)"
proof -
let ?f = "λv. (v, if ListMem v (add_effects_of op) then True else False)"
and ?g = "λv. (v, if ListMem v (delete_effects_of op) then False else True)"
{
have "map ?f (add_effects_of op @ delete_effects_of op)
= map ?f (add_effects_of op) @ map ?f (delete_effects_of op)"
using map_append
by fast
hence "effect_to_assignments op = map ?f (add_effects_of op @ delete_effects_of op)"
using ListMem_iff assms
by fastforce
} moreover {
have "map ?g (add_effects_of op @ delete_effects_of op)
= map ?g (add_effects_of op) @ map ?g (delete_effects_of op)"
using map_append
by fast
hence "effect_to_assignments op = map ?g (add_effects_of op @ delete_effects_of op)"
using ListMem_iff assms
by fastforce
}
ultimately show "effect_to_assignments op = map
(λv. (v, if ListMem v (add_effects_of op) then True else False))
(add_effects_of op @ delete_effects_of op)"
and "effect_to_assignments op = map
(λv. (v, if ListMem v (delete_effects_of op) then False else True))
(add_effects_of op @ delete_effects_of op)"
by blast+
qed
corollary map_of_effect_to_assignments_is_none_if:
assumes "¬v ∈ set (add_effects_of op)"
and "¬v ∈ set (delete_effects_of op)"
shows "map_of (effect_to_assignments op) v = None"
proof -
let ?l = "effect_to_assignments op"
{
have "set ?l = { (v, True) | v. v ∈ set (add_effects_of op) }
∪ { (v, False) | v. v ∈ set (delete_effects_of op)}"
by auto
then have "fst ` set ?l
= (fst ` {(v, True) | v. v ∈ set (add_effects_of op)})
∪ (fst ` {(v, False) | v. v ∈ set (delete_effects_of op)})"
using image_Un[of fst "{(v, True) | v. v ∈ set (add_effects_of op)}"
"{(v, False) | v. v ∈ set (delete_effects_of op)}"]
by presburger
also have "… = (fst ` (λv. (v, True)) ` set (add_effects_of op))
∪ (fst ` (λv. (v, False)) ` set (delete_effects_of op))"
using setcompr_eq_image[of "λv. (v, True)" "λv. v ∈ set (add_effects_of op)"]
setcompr_eq_image[of "λv. (v, False)" "λv. v ∈ set (delete_effects_of op)"]
by simp
also have "… = id ` set (add_effects_of op) ∪ id ` set (delete_effects_of op)"
by force
finally have "fst ` set ?l = set (add_effects_of op) ∪ set (delete_effects_of op)"
by auto
hence "v ∉ fst ` set ?l"
using assms(1, 2)
by blast
}
thus ?thesis
using map_of_eq_None_iff[of ?l v]
by blast
qed
lemma execute_parallel_operator_positive_effect_if_i:
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
and "op ∈ set ops"
and "v ∈ set (add_effects_of op)"
shows "map_of (effect_to_assignments op) v = Some True"
proof -
let ?f = "λx. if ListMem x (add_effects_of op) then True else False"
and ?l'= " map (λv. (v, if ListMem v (add_effects_of op) then True else False))
(add_effects_of op @ delete_effects_of op)"
have "set (add_effects_of op) ≠ {}"
using assms(4)
by fastforce
moreover {
have "set (add_effects_of op) ∩ set (delete_effects_of op) = {}"
using are_all_operator_effects_consistent_set assms(2, 3)
by fast
moreover have "effect_to_assignments op = ?l'"
using effect_to_assignments_construction_from_function_graph(1) calculation
by fast
ultimately have "map_of (effect_to_assignments op) = map_of ?l'"
by argo
}
ultimately have "map_of (effect_to_assignments op) v = Some (?f v)"
using Map_Supplement.map_of_from_function_graph_is_some_if[
of _ _ "?f", OF _ assms(4)]
by simp
thus ?thesis
using ListMem_iff assms(4)
by metis
qed
lemma execute_parallel_operator_positive_effect_if:
fixes ops
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
and "op ∈ set ops"
and "v ∈ set (add_effects_of op)"
shows "execute_parallel_operator s ops v = Some True"
proof -
let ?l = "map (map_of ∘ effect_to_assignments) ops"
have set_l_is: "set ?l = (map_of ∘ effect_to_assignments) ` set ops"
using set_map
by fastforce
{
let ?m = "(map_of ∘ effect_to_assignments) op"
have "?m ∈ set ?l"
using assms(3) set_l_is
by blast
moreover have "?m v = Some True"
using execute_parallel_operator_positive_effect_if_i[OF assms]
by fastforce
ultimately have "∃m ∈ set ?l. m v = Some True"
by blast
}
moreover {
fix m'
assume "m' ∈ set ?l"
then obtain op'
where op'_in_set_ops: "op' ∈ set ops"
and m'_is: "m' = (map_of ∘ effect_to_assignments) op'"
by auto
then have "set (add_effects_of op) ∩ set (delete_effects_of op') = {}"
using assms(2, 3) are_all_operator_effects_consistent_set[of ops]
by blast
then have "v ∉ set (delete_effects_of op')"
using assms(4)
by blast
then consider (v_in_set_add_effects) "v ∈ set (add_effects_of op')"
| (otherwise) "¬v ∈ set (add_effects_of op') ∧ ¬v ∈ set (delete_effects_of op')"
by blast
hence "m' v = Some True ∨ m' v = None"
proof (cases)
case v_in_set_add_effects
thus ?thesis
using execute_parallel_operator_positive_effect_if_i[
OF assms(1, 2) op'_in_set_ops, of v] m'_is
by simp
next
case otherwise
then have "¬v ∈ set (add_effects_of op')"
and "¬v ∈ set (delete_effects_of op')"
by blast+
thus ?thesis
using map_of_effect_to_assignments_is_none_if[of v op'] m'_is
by fastforce
qed
}
ultimately show ?thesis
unfolding execute_parallel_operator_def
using foldl_map_append_is_some_if[of s v True ?l]
by meson
qed
lemma execute_parallel_operator_negative_effect_if_i:
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
and "op ∈ set ops"
and "v ∈ set (delete_effects_of op)"
shows "map_of (effect_to_assignments op) v = Some False"
proof -
let ?f = "λx. if ListMem x (delete_effects_of op) then False else True"
and ?l'= " map (λv. (v, if ListMem v (delete_effects_of op) then False else True))
(add_effects_of op @ delete_effects_of op)"
have "set (delete_effects_of op @ add_effects_of op) ≠ {}"
using assms(4)
by fastforce
moreover have "v ∈ set (delete_effects_of op @ add_effects_of op)"
using assms(4)
by simp
moreover {
have "set (add_effects_of op) ∩ set (delete_effects_of op) = {}"
using are_all_operator_effects_consistent_set assms(2, 3)
by fast
moreover have "effect_to_assignments op = ?l'"
using effect_to_assignments_construction_from_function_graph(2) calculation
by blast
ultimately have "map_of (effect_to_assignments op) = map_of ?l'"
by argo
}
ultimately have "map_of (effect_to_assignments op) v = Some (?f v)"
using Map_Supplement.map_of_from_function_graph_is_some_if[
of "add_effects_of op @ delete_effects_of op" v "?f"]
by force
thus ?thesis
using assms(4)
unfolding ListMem_iff
by presburger
qed
lemma execute_parallel_operator_negative_effect_if:
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
and "op ∈ set ops"
and "v ∈ set (delete_effects_of op)"
shows "execute_parallel_operator s ops v = Some False"
proof -
let ?l = "map (map_of ∘ effect_to_assignments) ops"
have set_l_is: "set ?l = (map_of ∘ effect_to_assignments) ` set ops"
using set_map
by fastforce
{
let ?m = "(map_of ∘ effect_to_assignments) op"
have "?m ∈ set ?l"
using assms(3) set_l_is
by blast
moreover have "?m v = Some False"
using execute_parallel_operator_negative_effect_if_i[OF assms]
by fastforce
ultimately have "∃m ∈ set ?l. m v = Some False"
by blast
}
moreover {
fix m'
assume "m' ∈ set ?l"
then obtain op'
where op'_in_set_ops: "op' ∈ set ops"
and m'_is: "m' = (map_of ∘ effect_to_assignments) op'"
by auto
then have "set (delete_effects_of op) ∩ set (add_effects_of op') = {}"
using assms(2, 3) are_all_operator_effects_consistent_set[of ops]
by blast
then have "v ∉ set (add_effects_of op')"
using assms(4)
by blast
then consider (v_in_set_delete_effects) "v ∈ set (delete_effects_of op')"
| (otherwise) "¬v ∈ set (add_effects_of op') ∧ ¬v ∈ set (delete_effects_of op')"
by blast
hence "m' v = Some False ∨ m' v = None"
proof (cases)
case v_in_set_delete_effects
thus ?thesis
using execute_parallel_operator_negative_effect_if_i[
OF assms(1, 2) op'_in_set_ops, of v] m'_is
by simp
next
case otherwise
then have "¬v ∈ set (add_effects_of op')"
and "¬v ∈ set (delete_effects_of op')"
by blast+
thus ?thesis
using map_of_effect_to_assignments_is_none_if[of v op'] m'_is
by fastforce
qed
}
ultimately show ?thesis
unfolding execute_parallel_operator_def
using foldl_map_append_is_some_if[of s v False ?l]
by meson
qed
lemma execute_parallel_operator_no_effect_if:
assumes "∀op ∈ set ops. ¬v ∈ set (add_effects_of op) ∧ ¬v ∈ set (delete_effects_of op)"
shows "execute_parallel_operator s ops v = s v"
using assms
unfolding execute_parallel_operator_def
proof (induction ops arbitrary: s)
case (Cons a ops)
let ?f = "map_of ∘ effect_to_assignments"
{
have "v ∉ set (add_effects_of a) ∧ v ∉ set (delete_effects_of a)"
using Cons.prems(1)
by force
then have "?f a v = None"
using map_of_effect_to_assignments_is_none_if[of v a]
by fastforce
then have "v ∉ dom (?f a)"
by blast
hence "(s ++ ?f a) v = s v"
using map_add_dom_app_simps(3)[of v "?f a" s]
by blast
}
moreover {
have "∀op∈set ops. v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)"
using Cons.prems(1)
by simp
hence "foldl (++) (s ++ ?f a) (map ?f ops) v = (s ++ ?f a) v"
using Cons.IH[of "s ++ ?f a"]
by blast
}
moreover {
have "map ?f (a # ops) = ?f a # map ?f ops"
by force
then have "foldl (++) s (map ?f (a # ops))
= foldl (++) (s ++ ?f a) (map ?f ops)"
using foldl_Cons
by force
}
ultimately show ?case
by argo
qed fastforce
corollary execute_parallel_operators_strips_none_if:
assumes "∀op ∈ set ops. ¬v ∈ set (add_effects_of op) ∧ ¬v ∈ set (delete_effects_of op)"
and "s v = None"
shows "execute_parallel_operator s ops v = None"
using execute_parallel_operator_no_effect_if[OF assms(1)] assms(2)
by simp
corollary execute_parallel_operators_strips_none_if_contraposition:
assumes "¬execute_parallel_operator s ops v = None"
shows "(∃op ∈ set ops. v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op))
∨ s v ≠ None"
proof -
let ?P = "(∀op ∈ set ops. ¬v ∈ set (add_effects_of op) ∧ ¬v ∈ set (delete_effects_of op))
∧ s v = None"
and ?Q = "execute_parallel_operator s ops v = None"
have "?P ⟹ ?Q"
using execute_parallel_operators_strips_none_if[of ops v s]
by blast
then have "¬?P"
using contrapos_nn[of ?Q ?P]
using assms
by argo
thus ?thesis
by meson
qed
text ‹ We will now move on to showing the equivalent to theorem \isaname{operator_effect__strips}
in \isaname{execute_parallel_operator_effect}.
Under the condition that for a list of operators \<^term>‹ops› all
operators in the corresponding set are applicable in a given state \<^term>‹s› and all operator effects
are consistent, if an operator \<^term>‹op› exists with \<^term>‹op ∈ set ops› and with \<^term>‹v› being
an add effect of \<^term>‹op›, then the successor state
@{text[display, indent=4] "s' ≡ execute_parallel_operator s ops"}
will evaluate \<^term>‹v› to true, that is
@{text[display, indent=4] "execute_parallel_operator s ops v = Some True"}
Symmetrically, if \<^term>‹v› is a delete effect, we have
@{text[display, indent=4] "execute_parallel_operator s ops v = Some False"}
under the same condition as for the positive effect.
Lastly, if \<^term>‹v› is neither an add effect nor a delete effect for any operator in the
operator set corresponding to $ops$, then the state after parallel operator execution remains
unchanged, i.e.
@{text[display, indent=4] "execute_parallel_operator s ops v = s v"}
›
theorem execute_parallel_operator_effect:
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
shows "op ∈ set ops ∧ v ∈ set (add_effects_of op)
⟶ execute_parallel_operator s ops v = Some True"
and "op ∈ set ops ∧ v ∈ set (delete_effects_of op)
⟶ execute_parallel_operator s ops v = Some False"
and "(∀op ∈ set ops.
v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op))
⟶ execute_parallel_operator s ops v = s v"
using execute_parallel_operator_positive_effect_if[OF assms]
execute_parallel_operator_negative_effect_if[OF assms]
execute_parallel_operator_no_effect_if[of ops v s]
by blast+
lemma is_parallel_solution_for_problem_operator_set:
fixes Π:: "'a strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "ops ∈ set π"
and "op ∈ set ops"
shows "op ∈ set ((Π)⇩𝒪)"
proof -
have "∀ops ∈ set π. ∀op ∈ set ops. op ∈ set (strips_problem.operators_of Π)"
using assms(1)
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff..
thus ?thesis
using assms(2, 3)
by fastforce
qed
lemma trace_parallel_plan_strips_not_nil: "trace_parallel_plan_strips I π ≠ []"
proof (cases π)
case (Cons a list)
then show ?thesis
by (cases "are_all_operators_applicable I (hd π) ∧ are_all_operator_effects_consistent (hd π)"
, simp+)
qed simp
corollary length_trace_parallel_plan_gt_0[simp]: "0 < length (trace_parallel_plan_strips I π)"
using trace_parallel_plan_strips_not_nil..
corollary length_trace_minus_one_lt_length_trace[simp]:
"length (trace_parallel_plan_strips I π) - 1 < length (trace_parallel_plan_strips I π)"
using diff_less[OF _ length_trace_parallel_plan_gt_0]
by auto
lemma trace_parallel_plan_strips_head_is_initial_state:
"trace_parallel_plan_strips I π ! 0 = I"
proof (cases π)
case (Cons a list)
then show ?thesis
by (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a", simp+)
qed simp
lemma trace_parallel_plan_strips_length_gt_one_if:
assumes "k < length (trace_parallel_plan_strips I π) - 1"
shows "1 < length (trace_parallel_plan_strips I π)"
using assms
by linarith
lemma trace_parallel_plan_strips_last_cons_then:
"last (s # trace_parallel_plan_strips s' π) = last (trace_parallel_plan_strips s' π)"
by (cases π, simp, force)
text ‹ Parallel plan traces have some important properties that we want to confirm before
proceeding. Let \<^term>‹τ ≡ trace_parallel_plan_strips I π› be a trace for a parallel plan \<^term>‹π›
with initial state \<^term>‹I›.
First, all parallel operators \<^term>‹ops = π ! k› for any index \<^term>‹k› with \<^term>‹k < length τ - 1›
(meaning that \<^term>‹k› is not the index of the last element).
must be applicable and their effects must be consistent. Otherwise, the trace would have terminated
and \<^term>‹ops› would have been the last element. This would violate the assumption that \<^term>‹k < length τ - 1›
is not the last index since the index of the last element is \<^term>‹length τ - 1›.
\footnote{More precisely, the index of the last element is \<^term>‹length τ - 1› if \<^term>‹τ› is not
empty which is however always true since the trace contains at least the initial state.} ›
lemma trace_parallel_plan_strips_operator_preconditions:
assumes "k < length (trace_parallel_plan_strips I π) - 1"
shows "are_all_operators_applicable (trace_parallel_plan_strips I π ! k) (π ! k)
∧ are_all_operator_effects_consistent (π ! k)"
using assms
proof (induction "π" arbitrary: I k)
case (Cons a π)
then show ?case
proof (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a")
case True
have trace_parallel_plan_strips_cons: "trace_parallel_plan_strips I (a # π)
= I # trace_parallel_plan_strips (execute_parallel_operator I a) π"
using True
by simp
then show ?thesis
proof (cases "k")
case 0
have "trace_parallel_plan_strips I (a # π) ! 0 = I"
using trace_parallel_plan_strips_cons
by simp
moreover have "(a # π) ! 0 = a"
by simp
ultimately show ?thesis
using True 0
by presburger
next
case (Suc k')
let ?I' = "execute_parallel_operator I a"
have "trace_parallel_plan_strips I (a # π) ! Suc k' = trace_parallel_plan_strips ?I' π ! k'"
using trace_parallel_plan_strips_cons
by simp
moreover have "(a # π) ! Suc k' = π ! k'"
by simp
moreover {
have "length (trace_parallel_plan_strips I (a # π))
= 1 + length (trace_parallel_plan_strips ?I' π)"
unfolding trace_parallel_plan_strips_cons
by simp
then have "k' < length (trace_parallel_plan_strips ?I' π) - 1"
using Suc Cons.prems
by fastforce
hence "are_all_operators_applicable (trace_parallel_plan_strips ?I' π ! k') (π ! k')
∧ are_all_operator_effects_consistent (π ! k')"
using Cons.IH[of k']
by blast
}
ultimately show ?thesis
using Suc
by argo
qed
next
case False
then have "trace_parallel_plan_strips I (a # π) = [I]"
by force
then have "length (trace_parallel_plan_strips I (a # π)) - 1 = 0"
by simp
then show ?thesis
using Cons.prems
by force
qed
qed auto
text ‹ Another interesting property that we verify below is that elements of the trace
store the result of plan prefix execution. This means that for an index \<^term>‹k› with\newline
\<^term>‹k < length (trace_parallel_plan_strips I π)›, the \<^term>‹k›-th element of the trace is state
reached by executing the plan prefix \<^term>‹take k π› consisting of the first \<^term>‹k› parallel
operators of \<^term>‹π›. ›
lemma trace_parallel_plan_plan_prefix:
assumes "k < length (trace_parallel_plan_strips I π)"
shows "trace_parallel_plan_strips I π ! k = execute_parallel_plan I (take k π)"
using assms
proof (induction π arbitrary: I k)
case (Cons a π)
then show ?case
proof (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a")
case True
let ?σ = "trace_parallel_plan_strips I (a # π)"
and ?I' = "execute_parallel_operator I a"
have σ_equals: "?σ = I # trace_parallel_plan_strips ?I' π"
using True
by auto
then show ?thesis
proof (cases "k = 0")
case False
obtain k' where k_is_suc_of_k': "k = Suc k'"
using not0_implies_Suc[OF False]
by blast
then have "execute_parallel_plan I (take k (a # π))
= execute_parallel_plan ?I' (take k' π)"
using True
by simp
moreover have "trace_parallel_plan_strips I (a # π) ! k
= trace_parallel_plan_strips ?I' π ! k'"
using σ_equals k_is_suc_of_k'
by simp
moreover {
have "k' < length (trace_parallel_plan_strips (execute_parallel_operator I a) π)"
using Cons.prems σ_equals k_is_suc_of_k'
by force
hence "trace_parallel_plan_strips ?I' π ! k'
= execute_parallel_plan ?I' (take k' π)"
using Cons.IH[of k' ?I']
by blast
}
ultimately show ?thesis
by presburger
qed simp
next
case operator_precondition_violated: False
then show ?thesis
proof (cases "k = 0")
case False
then have "trace_parallel_plan_strips I (a # π) = [I]"
using operator_precondition_violated
by force
moreover have "execute_parallel_plan I (take k (a # π)) = I"
using Cons.prems operator_precondition_violated
by force
ultimately show ?thesis
using Cons.prems nth_Cons_0
by auto
qed simp
qed
qed simp
lemma length_trace_parallel_plan_strips_lte_length_plan_plus_one:
shows "length (trace_parallel_plan_strips I π) ≤ length π + 1"
proof (induction π arbitrary: I)
case (Cons a π)
then show ?case
proof (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a")
case True
let ?I' = "execute_parallel_operator I a"
{
have "trace_parallel_plan_strips I (a # π) = I # trace_parallel_plan_strips ?I' π"
using True
by auto
then have "length (trace_parallel_plan_strips I (a # π))
= length (trace_parallel_plan_strips ?I' π) + 1"
by simp
moreover have "length (trace_parallel_plan_strips ?I' π) ≤ length π + 1"
using Cons.IH[of ?I']
by blast
ultimately have "length (trace_parallel_plan_strips I (a # π)) ≤ length (a # π) + 1"
by simp
}
thus ?thesis
by blast
qed auto
qed simp
lemma plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements:
assumes "k < length (trace_parallel_plan_strips I π) - 1"
obtains ops π' where "π = ops # π'"
proof -
let ?τ = "trace_parallel_plan_strips I π"
have "length ?τ ≤ length π + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one
by fast
then have "0 < length π"
using trace_parallel_plan_strips_length_gt_one_if assms
by force
then obtain k' where "length π = Suc k'"
using gr0_implies_Suc
by meson
thus ?thesis using that
using length_Suc_conv[of π k']
by blast
qed
corollary length_trace_parallel_plan_strips_lt_length_plan_plus_one_then:
assumes "length (trace_parallel_plan_strips I π) < length π + 1"
shows "¬are_all_operators_applicable
(execute_parallel_plan I (take (length (trace_parallel_plan_strips I π) - 1) π))
(π ! (length (trace_parallel_plan_strips I π) - 1))
∨ ¬are_all_operator_effects_consistent (π ! (length (trace_parallel_plan_strips I π) - 1))"
using assms
proof (induction π arbitrary: I)
case (Cons ops π)
let ?τ = "trace_parallel_plan_strips I (ops # π)"
and ?I' = "execute_parallel_operator I ops"
show ?case
proof (cases "are_all_operators_applicable I ops ∧ are_all_operator_effects_consistent ops")
case True
then have τ_is: "?τ = I # trace_parallel_plan_strips ?I' π"
by fastforce
show ?thesis
proof (cases "length (trace_parallel_plan_strips ?I' π) < length π + 1")
case True
then have "¬ are_all_operators_applicable
(execute_parallel_plan ?I'
(take (length (trace_parallel_plan_strips ?I' π) - 1) π))
(π ! (length (trace_parallel_plan_strips ?I' π) - 1))
∨ ¬ are_all_operator_effects_consistent
(π ! (length (trace_parallel_plan_strips ?I' π) - 1))"
using Cons.IH[of ?I']
by blast
moreover have "trace_parallel_plan_strips ?I' π ≠ []"
using trace_parallel_plan_strips_not_nil
by blast
ultimately show ?thesis
unfolding take_Cons'
by simp
next
case False
then have "length (trace_parallel_plan_strips ?I' π) ≥ length π + 1"
by fastforce
thm Cons.prems
moreover have "length (trace_parallel_plan_strips I (ops # π))
= 1 + length (trace_parallel_plan_strips ?I' π)"
using True
by force
moreover have "length (trace_parallel_plan_strips ?I' π)
< length (ops # π)"
using Cons.prems calculation(2)
by force
ultimately have False
by fastforce
thus ?thesis..
qed
next
case False
then have τ_is_singleton: "?τ = [I]"
using False
by auto
then have "ops = (ops # π) ! (length ?τ - 1)"
by fastforce
moreover have "execute_parallel_plan I (take (length ?τ - 1) π) = I"
using τ_is_singleton
by auto
ultimately show ?thesis
using False
by auto
qed
qed simp
lemma trace_parallel_plan_step_effect_is:
assumes "k < length (trace_parallel_plan_strips I π) - 1"
shows "trace_parallel_plan_strips I π ! Suc k
= execute_parallel_operator (trace_parallel_plan_strips I π ! k) (π ! k)"
proof -
{
let ?τ = "trace_parallel_plan_strips I π"
have "Suc k < length ?τ"
using assms
by linarith
hence "trace_parallel_plan_strips I π ! Suc k
= execute_parallel_plan I (take (Suc k) π)"
using trace_parallel_plan_plan_prefix[of "Suc k" I π]
by blast
}
moreover have "execute_parallel_plan I (take (Suc k) π)
= execute_parallel_operator (trace_parallel_plan_strips I π ! k) (π ! k)"
using assms
proof (induction k arbitrary: I π)
case 0
then have "execute_parallel_operator (trace_parallel_plan_strips I π ! 0) (π ! 0)
= execute_parallel_operator I (π ! 0)"
using trace_parallel_plan_strips_head_is_initial_state[of I π]
by argo
moreover {
obtain ops π' where "π = ops # π'"
using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF "0.prems"]
by blast
then have "take (Suc 0) π = [π ! 0]"
by simp
hence "execute_parallel_plan I (take (Suc 0) π)
= execute_parallel_plan I [π ! 0]"
by argo
}
moreover {
have "0 < length (trace_parallel_plan_strips I π) - 1"
using trace_parallel_plan_strips_length_gt_one_if "0.prems"
by fastforce
hence "are_all_operators_applicable I (π ! 0)
∧ are_all_operator_effects_consistent (π ! 0)"
using trace_parallel_plan_strips_operator_preconditions[of 0 I π]
trace_parallel_plan_strips_head_is_initial_state[of I π]
by argo
}
ultimately show ?case
by auto
next
case (Suc k)
obtain ops π' where π_split: "π = ops # π'"
using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF Suc.prems]
by blast
let ?I' = "execute_parallel_operator I ops"
{
have "length (trace_parallel_plan_strips I π) =
1 + length (trace_parallel_plan_strips ?I' π')"
using Suc.prems π_split
by fastforce
then have "k < length (trace_parallel_plan_strips ?I' π')"
using Suc.prems
by fastforce
moreover have "trace_parallel_plan_strips I π ! Suc k
= trace_parallel_plan_strips ?I' π' ! k"
using Suc.prems π_split
by force
ultimately have "trace_parallel_plan_strips I π ! Suc k
= execute_parallel_plan ?I' (take k π')"
using trace_parallel_plan_plan_prefix[of k ?I' π']
by argo
}
moreover have "execute_parallel_plan I (take (Suc (Suc k)) π)
= execute_parallel_plan ?I' (take (Suc k) π')"
using Suc.prems π_split
by fastforce
moreover {
have "0 < length (trace_parallel_plan_strips I π) - 1"
using Suc.prems
by linarith
hence "are_all_operators_applicable I (π ! 0)
∧ are_all_operator_effects_consistent (π ! 0)"
using trace_parallel_plan_strips_operator_preconditions[of 0 I π]
trace_parallel_plan_strips_head_is_initial_state[of I π]
by argo
}
ultimately show ?case
using Suc.IH Suc.prems π_split
by auto
qed
ultimately show ?thesis
using assms
by argo
qed
lemma trace_parallel_plan_strips_none_if:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "k < length (trace_parallel_plan_strips ((Π)⇩I) π)"
shows "(trace_parallel_plan_strips ((Π)⇩I) π ! k) v = None ⟷ v ∉ set ((Π)⇩𝒱)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
and ?I = "strips_problem.initial_of Π"
show ?thesis
using assms
proof (induction k)
case 0
have "?τ ! 0 = ?I"
using trace_parallel_plan_strips_head_is_initial_state
by auto
then show ?case
using is_valid_problem_strips_initial_of_dom[OF assms(1)]
by auto
next
case (Suc k)
have k_lt_length_τ_minus_one: "k < length ?τ - 1"
using Suc.prems(3)
by linarith
then have IH: "(trace_parallel_plan_strips ?I π ! k) v = None ⟷ v ∉set ((Π)⇩𝒱)"
using Suc.IH[OF Suc.prems(1, 2)]
by force
have τ_Suc_k_is: "(?τ ! Suc k) = execute_parallel_operator (?τ ! k) (π ! k)"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
have all_operators_applicable: "are_all_operators_applicable (?τ ! k) (π ! k)"
and all_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
by simp+
show ?case
proof (rule iffI)
assume τ_Suc_k_of_v_is_None: "(?τ ! Suc k) v = None"
show "v ∉ set ((Π)⇩𝒱)"
proof (rule ccontr)
assume "¬v ∉ set ((Π)⇩𝒱)"
then have v_in_set_vs: "v ∈ set((Π)⇩𝒱)"
by blast
show False
proof (cases "∃op ∈ set (π ! k).
v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op)")
case True
then obtain op
where op_in_π⇩k: "op ∈ set (π ! k)"
and "v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op)"..
then consider (A) "v ∈ set (add_effects_of op)"
| (B) "v ∈ set (delete_effects_of op)"
by blast
thus False
using execute_parallel_operator_positive_effect_if[OF
all_operators_applicable all_effects_consistent op_in_π⇩k]
execute_parallel_operator_negative_effect_if[OF
all_operators_applicable all_effects_consistent op_in_π⇩k]
τ_Suc_k_of_v_is_None τ_Suc_k_is
by (cases, fastforce+)
next
case False
then have "∀op ∈ set (π ! k).
v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)"
by blast
then have "(?τ ! Suc k) v = (?τ ! k) v"
using execute_parallel_operator_no_effect_if τ_Suc_k_is
by fastforce
then have "v ∉ set ((Π)⇩𝒱)"
using IH τ_Suc_k_of_v_is_None
by simp
thus False
using v_in_set_vs
by blast
qed
qed
next
assume v_notin_vs: "v ∉ set ((Π)⇩𝒱)"
{
fix op
assume op_in_π⇩k: "op ∈ set (π ! k)"
{
have "1 < length ?τ"
using trace_parallel_plan_strips_length_gt_one_if[OF k_lt_length_τ_minus_one].
then have "0 < length ?τ - 1"
using k_lt_length_τ_minus_one
by linarith
moreover have "length ?τ - 1 ≤ length π"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one le_diff_conv
by blast
then have "k < length π"
using k_lt_length_τ_minus_one
by force
hence "π ! k ∈ set π"
by simp
}
then have op_in_ops: "op ∈ set ?ops"
using is_parallel_solution_for_problem_operator_set[OF assms(2) _ op_in_π⇩k]
by force
hence "v ∉ set (add_effects_of op)" and "v ∉ set (delete_effects_of op)"
subgoal
using is_valid_problem_strips_operator_variable_sets(2) assms(1) op_in_ops
v_notin_vs
by auto
subgoal
using is_valid_problem_strips_operator_variable_sets(3) assms(1) op_in_ops
v_notin_vs
by auto
done
}
then have "(?τ ! Suc k) v = (?τ ! k) v"
using execute_parallel_operator_no_effect_if τ_Suc_k_is
by metis
thus "(?τ ! Suc k) v = None"
using IH v_notin_vs
by fastforce
qed
qed
qed
text ‹ Finally, given initial and goal states \<^term>‹I› and \<^term>‹G›, we can show that it's
equivalent to say that \<^term>‹π› is a solution for \<^term>‹I› and \<^term>‹G›---i.e.
\<^term>‹G ⊆⇩m execute_parallel_plan I π›---and
that the goal state is subsumed by the last element of the trace of \<^term>‹π› with initial state
\<^term>‹I›. ›
lemma execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace:
"G ⊆⇩m execute_parallel_plan I π
⟷ G ⊆⇩m last (trace_parallel_plan_strips I π)"
proof -
let ?LHS = "G ⊆⇩m execute_parallel_plan I π"
and ?RHS = "G ⊆⇩m last (trace_parallel_plan_strips I π)"
show ?thesis
proof (rule iffI)
assume ?LHS
thus ?RHS
proof (induction π arbitrary: I)
case (Cons a π)
thus ?case
using Cons.prems
proof (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a")
case True
let ?I' = "execute_parallel_operator I a"
{
have "execute_parallel_plan I (a # π) = execute_parallel_plan ?I' π"
using True
by auto
then have "G ⊆⇩m execute_parallel_plan ?I' π"
using Cons.prems
by presburger
hence "G ⊆⇩m last (trace_parallel_plan_strips ?I' π)"
using Cons.IH[of ?I']
by blast
}
moreover {
have "trace_parallel_plan_strips I (a # π)
= I # trace_parallel_plan_strips ?I' π"
using True
by simp
then have "last (trace_parallel_plan_strips I (a # π))
= last (I # trace_parallel_plan_strips ?I' π)"
by argo
hence "last (trace_parallel_plan_strips I (a # π))
= last (trace_parallel_plan_strips ?I' π)"
using trace_parallel_plan_strips_last_cons_then[of I ?I' π]
by argo
}
ultimately show ?thesis
by argo
qed force
qed simp
next
assume ?RHS
thus ?LHS
proof (induction π arbitrary: I)
case (Cons a π)
thus ?case
proof (cases "are_all_operators_applicable I a ∧ are_all_operator_effects_consistent a")
case True
let ?I' = "execute_parallel_operator I a"
{
have "trace_parallel_plan_strips I (a # π) = I # (trace_parallel_plan_strips ?I' π)"
using True
by simp
then have "last (trace_parallel_plan_strips I (a # π))
= last (trace_parallel_plan_strips ?I' π)"
using trace_parallel_plan_strips_last_cons_then[of I ?I' π]
by argo
hence "G ⊆⇩m last (trace_parallel_plan_strips ?I' π)"
using Cons.prems
by argo
}
thus ?thesis
using True Cons
by simp
next
case False
then have "last (trace_parallel_plan_strips I (a # π)) = I"
and "execute_parallel_plan I (a # π) = I"
by (fastforce, force)
thus ?thesis
using Cons.prems
by argo
qed
qed fastforce
qed
qed
subsection "Serializable Parallel Plans"
text ‹ With the groundwork on parallel and serial execution of STRIPS in place we can now address
the question under which conditions a parallel solution to a problem corresponds to a serial
solution and vice versa.
As we will see (in theorem \ref{isathm:embedding-serial-strips-plan}), while a serial plan can
be trivially rewritten as a parallel plan consisting of singleton operator list for each operator
in the plan, the condition for parallel plan solutions also involves non interference. ›
lemma execute_parallel_operator_equals_execute_sequential_strips_if:
fixes s :: "('variable, bool) state"
assumes "are_all_operators_applicable s ops"
and "are_all_operator_effects_consistent ops"
and "are_all_operators_non_interfering ops"
shows "execute_parallel_operator s ops = execute_serial_plan s ops"
using assms
proof (induction ops arbitrary: s)
case Nil
have "execute_parallel_operator s Nil
= foldl (++) s (map (map_of ∘ effect_to_assignments) Nil)"
using Nil.prems(1,2)
unfolding execute_parallel_operator_def
by presburger
also have "… = s"
by simp
finally have "execute_parallel_operator s Nil = s"
by blast
moreover have "execute_serial_plan s Nil = s"
by auto
ultimately show ?case
by simp
next
case (Cons a ops)
have a: "is_operator_applicable_in s a"
using are_all_operators_applicable_cons Cons.prems(1)
by blast+
let ?s' = "s ++ map_of (effect_to_assignments a)"
{
from Cons.prems
have "are_all_operators_applicable ?s' ops"
and "are_all_operator_effects_consistent ops"
and "are_all_operators_non_interfering ops"
using execute_parallel_plan_precondition_cons
by blast+
then have "execute_serial_plan ?s' ops
= execute_parallel_operator ?s' ops"
using Cons.IH
by presburger
}
moreover from Cons.prems
have "execute_parallel_operator s (Cons a ops)
= execute_parallel_operator ?s' ops"
using execute_parallel_operator_cons_equals_corollary
unfolding execute_operator_def
by simp
moreover
from a have "execute_serial_plan s (Cons a ops)
= execute_serial_plan ?s' ops"
unfolding execute_serial_plan_def execute_operator_def
is_operator_applicable_in_def
by fastforce
ultimately show ?case
by argo
qed
lemma execute_serial_plan_split_i:
assumes "are_all_operators_applicable s (op # π)"
and "are_all_operators_non_interfering (op # π)"
shows "are_all_operators_applicable (s ⪢ op) π"
using assms
proof (induction π arbitrary: s)
case Nil
then show ?case
unfolding are_all_operators_applicable_def
by simp
next
case (Cons op' π)
let ?t = "s ⪢ op"
{
fix x
assume "x ∈ set (op' # π)"
moreover have "op ∈ set (op # op' # π)"
by simp
moreover have "¬are_operators_interfering op x"
using Cons.prems(2) calculation(1)
unfolding are_all_operators_non_interfering_def list_all_iff
by fastforce
moreover have "is_operator_applicable_in s op"
using Cons.prems(1)
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by force
moreover have "is_operator_applicable_in s x"
using are_all_operators_applicable_cons(2)[OF Cons.prems(1)] calculation(1)
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by fast
ultimately have "is_operator_applicable_in ?t x"
using execute_parallel_plan_precondition_cons_i[of op x s]
by (auto simp: execute_operator_def)
}
thus ?case
using are_all_operators_applicable_cons(2)
unfolding is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def
are_all_operators_applicable_def list_all_iff
by simp
qed
lemma execute_serial_plan_split:
fixes s :: "('variable, bool) state"
assumes "are_all_operators_applicable s π⇩1"
and "are_all_operators_non_interfering π⇩1"
shows "execute_serial_plan s (π⇩1 @ π⇩2)
= execute_serial_plan (execute_serial_plan s π⇩1) π⇩2"
using assms
proof (induction π⇩1 arbitrary: s)
case (Cons op π⇩1)
let ?t = "s ⪢ op"
{
have "are_all_operators_applicable (s ⪢ op) π⇩1"
using execute_serial_plan_split_i[OF Cons.prems(1, 2)].
moreover have "are_all_operators_non_interfering π⇩1"
using are_all_operators_non_interfering_tail[OF Cons.prems(2)].
ultimately have "execute_serial_plan ?t (π⇩1 @ π⇩2) =
execute_serial_plan (execute_serial_plan ?t π⇩1) π⇩2"
using Cons.IH[of ?t]
by blast
}
moreover have "STRIPS_Representation.is_operator_applicable_in s op"
using Cons.prems(1)
unfolding are_all_operators_applicable_def list_all_iff
by fastforce
ultimately show ?case
unfolding execute_serial_plan_def
by simp
qed simp
lemma embedding_lemma_i:
fixes I :: "('variable, bool) state"
assumes "is_operator_applicable_in I op"
and "are_operator_effects_consistent op op"
shows "I ⪢ op = execute_parallel_operator I [op]"
proof -
have "are_all_operators_applicable I [op]"
using assms(1)
unfolding are_all_operators_applicable_def list_all_iff is_operator_applicable_in_def
by fastforce
moreover have "are_all_operator_effects_consistent [op]"
unfolding are_all_operator_effects_consistent_def list_all_iff
using assms(2)
by fastforce
moreover have "are_all_operators_non_interfering [op]"
by simp
moreover have "I ⪢ op = execute_serial_plan I [op]"
using assms(1)
unfolding is_operator_applicable_in_def
by (simp add: assms(1) execute_operator_def)
ultimately show ?thesis
using execute_parallel_operator_equals_execute_sequential_strips_if
by force
qed
lemma execute_serial_plan_is_execute_parallel_plan_ii:
fixes I :: "'variable strips_state"
assumes "∀op ∈ set π. are_operator_effects_consistent op op"
and "G ⊆⇩m execute_serial_plan I π"
shows "G ⊆⇩m execute_parallel_plan I (embed π)"
proof -
show ?thesis
using assms
proof (induction π arbitrary: I)
case (Cons op π)
then show ?case
proof (cases "is_operator_applicable_in I op")
case True
let ?J = "I ⪢ op"
and ?J' = "execute_parallel_operator I [op]"
{
have "G ⊆⇩m execute_serial_plan ?J π"
using Cons.prems(2) True
unfolding is_operator_applicable_in_def
by (simp add: True)
hence "G ⊆⇩m execute_parallel_plan ?J (embed π)"
using Cons.IH[of ?J] Cons.prems(1)
by fastforce
}
moreover {
have "are_all_operators_applicable I [op]"
using True
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by fastforce
moreover have "are_all_operator_effects_consistent [op]"
unfolding are_all_operator_effects_consistent_def list_all_iff
using Cons.prems(1)
by fastforce
moreover have "?J = ?J'"
using execute_parallel_operator_equals_execute_sequential_strips_if[OF
calculation(1, 2)] Cons.prems(1) True
unfolding is_operator_applicable_in_def
by (simp add: True)
ultimately have "execute_parallel_plan I (embed (op # π))
= execute_parallel_plan ?J (embed π)"
by fastforce
}
ultimately show ?thesis
by presburger
next
case False
then have "G ⊆⇩m I"
using Cons.prems is_operator_applicable_in_def
by simp
moreover {
have "¬are_all_operators_applicable I [op]"
using False
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by force
hence "execute_parallel_plan I (embed (op # π)) = I"
by simp
}
ultimately show ?thesis
by presburger
qed
qed simp
qed
lemma embedding_lemma_iii:
fixes Π:: "'a strips_problem"
assumes "∀op ∈ set π. op ∈ set ((Π)⇩𝒪)"
shows "∀ops ∈ set (embed π). ∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
proof -
have nb: "set (embed π) = { [op] | op. op ∈ set π }"
by (induction π; force)
{
fix ops
assume "ops ∈ set (embed π)"
moreover obtain op where "op ∈ set π" and "ops = [op]"
using nb calculation
by blast
ultimately have "∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
using assms(1)
by simp
}
thus ?thesis..
qed
text ‹ We show in the following theorem that---as mentioned---a serial solution \<^term>‹π› to a
STRIPS problem \<^term>‹Π› corresponds directly to a parallel solution obtained by embedding each operator
in \<^term>‹π› in a list (by use of function \<^term>‹embed›). The proof shows this by first
confirming that
@{text[display, indent=4] "G ⊆⇩m execute_serial_plan ((Π)⇩I) π
⟹ G ⊆⇩m execute_serial_plan ((Π)⇩I) (embed π)"}
using lemma \isaname{execute_serial_plan_is_execute_parallel_plan_strip_ii}; and
moreover by showing that
@{text[display, indent=4] "∀ops ∈ set (embed π). ∀op ∈ set ops. op ∈ (Π)⇩𝒪"}
meaning that under the given assumptions, all parallel operators of the embedded serial plan are
again operators in the operator set of the problem. ›
theorem embedding_lemma:
assumes "is_valid_problem_strips Π"
and "is_serial_solution_for_problem Π π"
shows "is_parallel_solution_for_problem Π (embed π)"
proof -
have nb⇩1: "∀op ∈ set π. op ∈ set ((Π)⇩𝒪)"
using assms(2)
unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff operators_of_def
by blast
{
fix op
assume "op ∈ set π"
moreover have "op ∈ set ((Π)⇩𝒪)"
using nb⇩1 calculation
by fast
moreover have "is_valid_operator_strips Π op"
using assms(1) calculation(2)
unfolding is_valid_problem_strips_def is_valid_problem_strips_def list_all_iff operators_of_def
by meson
moreover have "list_all (λv. ¬ListMem v (delete_effects_of op)) (add_effects_of op)"
and "list_all (λv. ¬ListMem v (add_effects_of op)) (delete_effects_of op)"
using calculation(3)
unfolding is_valid_operator_strips_def
by meson+
moreover have "¬list_ex (λv. ListMem v (delete_effects_of op)) (add_effects_of op)"
and "¬list_ex (λv. ListMem v (add_effects_of op)) (delete_effects_of op)"
using calculation(4, 5) not_list_ex_equals_list_all_not
by blast+
moreover have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (add_effects_of op)"
and "¬list_ex (λv. list_ex ((=) v) (add_effects_of op)) (delete_effects_of op)"
using calculation(6, 7)
unfolding list_ex_iff ListMem_iff
by blast+
ultimately have "are_operator_effects_consistent op op"
unfolding are_operator_effects_consistent_def Let_def
by blast
} note nb⇩2 = this
moreover {
have "(Π)⇩G ⊆⇩m execute_serial_plan ((Π)⇩I) π"
using assms(2)
unfolding is_serial_solution_for_problem_def
by simp
hence "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) (embed π)"
using execute_serial_plan_is_execute_parallel_plan_ii nb⇩2
by blast
}
moreover have "∀ops ∈ set (embed π). ∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
using embedding_lemma_iii[OF nb⇩1].
ultimately show ?thesis
unfolding is_parallel_solution_for_problem_def goal_of_def
initial_of_def operators_of_def list_all_iff ListMem_iff
by blast
qed
lemma flattening_lemma_i:
fixes Π:: "'a strips_problem"
assumes "∀ops ∈ set π. ∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
shows "∀op ∈ set (concat π). op ∈ set ((Π)⇩𝒪)"
proof -
{
fix op
assume "op ∈ set (concat π)"
moreover have "op ∈ (⋃ops ∈ set π. set ops)"
using calculation
unfolding set_concat.
then obtain ops where "ops ∈ set π" and "op ∈ set ops"
using UN_iff
by blast
ultimately have "op ∈ set ((Π)⇩𝒪)"
using assms
by blast
}
thus ?thesis..
qed
lemma flattening_lemma_ii:
fixes I :: "'variable strips_state"
assumes "∀ops ∈ set π. ∃op. ops = [op] ∧ is_valid_operator_strips Π op "
and "G ⊆⇩m execute_parallel_plan I π"
shows "G ⊆⇩m execute_serial_plan I (concat π)"
proof -
let ?π' = "concat π"
{
fix op
assume "is_valid_operator_strips Π op"
moreover have "list_all (λv. ¬ListMem v (delete_effects_of op)) (add_effects_of op)"
and "list_all (λv. ¬ListMem v (add_effects_of op)) (delete_effects_of op)"
using calculation(1)
unfolding is_valid_operator_strips_def
by meson+
moreover have "¬list_ex (λv. ListMem v (delete_effects_of op)) (add_effects_of op)"
and "¬list_ex (λv. ListMem v (add_effects_of op)) (delete_effects_of op)"
using calculation(2, 3) not_list_ex_equals_list_all_not
by blast+
moreover have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (add_effects_of op)"
and "¬list_ex (λv. list_ex ((=) v) (add_effects_of op)) (delete_effects_of op)"
using calculation(4, 5)
unfolding list_ex_iff ListMem_iff
by blast+
ultimately have "are_operator_effects_consistent op op"
unfolding are_operator_effects_consistent_def Let_def
by blast
} note nb⇩1 = this
show ?thesis
using assms
proof (induction π arbitrary: I)
case (Cons ops π)
obtain op where ops_is: "ops = [op]" and is_valid_op: "is_valid_operator_strips Π op"
using Cons.prems(1)
by fastforce
show ?case
proof (cases "are_all_operators_applicable I ops")
case True
let ?J = "execute_parallel_operator I [op]"
and ?J' = "I ⪢ op"
have nb⇩2: "is_operator_applicable_in I op"
using True ops_is
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by simp
have nb⇩3: "are_operator_effects_consistent op op"
using nb⇩1[OF is_valid_op].
{
then have "are_all_operator_effects_consistent ops"
unfolding are_all_operator_effects_consistent_def list_all_iff
using ops_is
by fastforce
hence "G ⊆⇩m execute_parallel_plan ?J π"
using Cons.prems(2) ops_is True
by fastforce
}
moreover have "execute_serial_plan I (concat (ops # π))
= execute_serial_plan ?J' (concat π)"
using ops_is nb⇩2
unfolding is_operator_applicable_in_def
by (simp add: execute_operator_def nb⇩2)
moreover have "?J = ?J'"
unfolding execute_parallel_operator_def execute_operator_def comp_apply
by fastforce
ultimately show ?thesis
using Cons.IH Cons.prems
by force
next
case False
moreover have "G ⊆⇩m I"
using Cons.prems(2) calculation
by force
moreover {
have "¬is_operator_applicable_in I op"
using ops_is False
unfolding are_all_operators_applicable_def list_all_iff
is_operator_applicable_in_def
by fastforce
hence "execute_serial_plan I (concat (ops # π)) = I"
using ops_is is_operator_applicable_in_def
by simp
}
ultimately show ?thesis
by argo
qed
qed force
qed
text ‹ The opposite direction is also easy to show if we can normalize the parallel plan to the
form of an embedded serial plan as shown below. ›
lemma flattening_lemma:
assumes "is_valid_problem_strips Π"
and "∀ops ∈ set π. ∃op. ops = [op]"
and "is_parallel_solution_for_problem Π π"
shows "is_serial_solution_for_problem Π (concat π)"
proof -
let ?π' = "concat π"
{
have "∀ops ∈ set π. ∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
using assms(3)
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
by force
hence "∀op ∈ set ?π'. op ∈ set ((Π)⇩𝒪)"
using flattening_lemma_i
by blast
}
moreover {
{
fix ops
assume "ops ∈ set π"
moreover obtain op where "ops = [op]"
using assms(2) calculation
by blast
moreover have "op ∈ set ((Π)⇩𝒪)"
using assms(3) calculation
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
by force
moreover have "is_valid_operator_strips Π op"
using assms(1) calculation(3)
unfolding is_valid_problem_strips_def Let_def list_all_iff ListMem_iff
by simp
ultimately have "∃op. ops = [op] ∧ is_valid_operator_strips Π op"
by blast
}
moreover have "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
using assms(3)
unfolding is_parallel_solution_for_problem_def
by simp
ultimately have "(Π)⇩G ⊆⇩m execute_serial_plan ((Π)⇩I) ?π'"
using flattening_lemma_ii
by blast
}
ultimately show "is_serial_solution_for_problem Π ?π'"
unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff
by simp
qed
text ‹ Finally, we can obtain the important result that a parallel plan with a trace that
reaches the goal state of a given problem \<^term>‹Π›, and for which both the parallel operator execution
condition as well as non interference is assured at every point \<^term>‹k < length π›, the flattening of
the parallel plan \<^term>‹concat π› is a serial solution for the initial and goal state of the problem.
To wit, by lemma \ref{isathm:parallel-solution-trace-strips} we have
@{text[display, indent=4] "(G ⊆⇩m execute_parallel_plan I π)
= (G ⊆⇩m last (trace_parallel_plan_strips I π))"}
so the second assumption entails that \<^term>‹π› is a solution for the initial state and the goal state
of the problem. (which implicitely means that \<^term>‹π› is a solution
for the inital state and goal state of the problem). The trace formulation is used in this case
because it allows us to write the---state dependent---applicability condition more succinctly. The
proof (shown below) is by structural induction on \<^term>‹π› with arbitrary initial state.›
theorem execute_parallel_plan_is_execute_sequential_plan_if:
fixes I :: "('variable, bool) state"
assumes "is_valid_problem Π"
and "G ⊆⇩m last (trace_parallel_plan_strips I π)"
and "∀k < length π.
are_all_operators_applicable (trace_parallel_plan_strips I π ! k) (π ! k)
∧ are_all_operator_effects_consistent (π ! k)
∧ are_all_operators_non_interfering (π ! k)"
shows "G ⊆⇩m execute_serial_plan I (concat π)"
using assms
proof (induction π arbitrary: I)
case (Cons ops π)
let ?ops' = "take (length ops) (concat (ops # π))"
let ?J = "execute_parallel_operator I ops"
and ?J' = "execute_serial_plan I ?ops'"
{
have "trace_parallel_plan_strips I π ! 0 = I" and "(ops # π) ! 0 = ops"
unfolding trace_parallel_plan_strips_head_is_initial_state
by simp+
then have "are_all_operators_applicable I ops"
and "are_all_operator_effects_consistent ops"
and "are_all_operators_non_interfering ops"
using Cons.prems(3)
by auto+
then have "trace_parallel_plan_strips I (ops # π)
= I # trace_parallel_plan_strips ?J π"
by fastforce
} note nb = this
{
have "last (trace_parallel_plan_strips I (ops # π))
= last (trace_parallel_plan_strips ?J π)"
using trace_parallel_plan_strips_last_cons_then nb
by metis
hence "G ⊆⇩m last (trace_parallel_plan_strips ?J π)"
using Cons.prems(2)
by force
}
moreover {
fix k
assume "k < length π"
moreover have "k + 1 < length (ops # π)"
using calculation
by force
moreover have "π ! k = (ops # π) ! (k + 1)"
by simp
ultimately have "are_all_operators_applicable
(trace_parallel_plan_strips ?J π ! k) (π ! k)"
and "are_all_operator_effects_consistent (π ! k)"
and "are_all_operators_non_interfering (π ! k)"
using Cons.prems(3) nb
by force+
}
ultimately have "G ⊆⇩m execute_serial_plan ?J (concat π)"
using Cons.IH[OF Cons.prems(1), of ?J]
by blast
moreover {
have "execute_serial_plan I (concat (ops # π))
= execute_serial_plan ?J' (concat π)"
using execute_serial_plan_split[of I ops] Cons.prems(3)
by auto
thm execute_parallel_operator_equals_execute_sequential_strips_if[of I]
moreover have "?J = ?J'"
using execute_parallel_operator_equals_execute_sequential_strips_if Cons.prems(3)
by fastforce
ultimately have "execute_serial_plan I (concat (ops # π))
= execute_serial_plan ?J (concat π)"
using execute_serial_plan_split[of I ops] Cons.prems(3)
by argo
}
ultimately show ?case
by argo
qed force
subsection "Auxiliary lemmas about STRIPS"
lemma set_to_precondition_of_op_is[simp]: "set (to_precondition op)
= { (v, True) | v. v ∈ set (precondition_of op) }"
unfolding to_precondition_def STRIPS_Representation.to_precondition_def set_map
by blast
end
Theory SAS_Plus_Representation
theory SAS_Plus_Representation
imports State_Variable_Representation
begin
section "SAS+ Representation"
text ‹ We now continue by defining a concrete implementation of SAS+.›
text ‹ SAS+ operators and SAS+ problems again use records. In contrast to STRIPS, the operator
effect is contracted into a single list however since we now potentially deal with more than two
possible values for each problem variable. ›
record ('variable, 'domain) sas_plus_operator =
precondition_of :: "('variable, 'domain) assignment list"
effect_of :: "('variable, 'domain) assignment list"
record ('variable, 'domain) sas_plus_problem =
variables_of :: "'variable list" ("(_⇩𝒱⇩+)" [1000] 999)
operators_of :: "('variable, 'domain) sas_plus_operator list" ("(_⇩𝒪⇩+)" [1000] 999)
initial_of :: "('variable, 'domain) state" ("(_⇩I⇩+)" [1000] 999)
goal_of :: "('variable, 'domain) state" ("(_⇩G⇩+)" [1000] 999)
range_of :: "'variable ⇀ 'domain list"
definition range_of':: "('variable, 'domain) sas_plus_problem ⇒ 'variable ⇒ 'domain set" ("ℛ⇩+ _ _" 52)
where
"range_of' Ψ v ≡
(case sas_plus_problem.range_of Ψ v of None ⇒ {}
| Some as ⇒ set as)"
definition to_precondition
:: "('variable, 'domain) sas_plus_operator ⇒ ('variable, 'domain) assignment list"
where "to_precondition ≡ precondition_of"
definition to_effect
:: "('variable, 'domain) sas_plus_operator ⇒ ('variable, 'domain) Effect"
where "to_effect op ≡ [(v, a) . (v, a) ← effect_of op]"
type_synonym ('variable, 'domain) sas_plus_plan
= "('variable, 'domain) sas_plus_operator list"
type_synonym ('variable, 'domain) sas_plus_parallel_plan
= "('variable, 'domain) sas_plus_operator list list"
abbreviation empty_operator
:: "('variable, 'domain) sas_plus_operator" ("ρ")
where "empty_operator ≡ ⦇ precondition_of = [], effect_of = [] ⦈"
definition is_valid_operator_sas_plus
:: "('variable, 'domain) sas_plus_problem ⇒ ('variable, 'domain) sas_plus_operator ⇒ bool"
where "is_valid_operator_sas_plus Ψ op ≡ let
pre = precondition_of op
; eff = effect_of op
; vs = variables_of Ψ
; D = range_of Ψ
in list_all (λ(v, a). ListMem v vs) pre
∧ list_all (λ(v, a). (D v ≠ None) ∧ ListMem a (the (D v))) pre
∧ list_all (λ(v, a). ListMem v vs) eff
∧ list_all (λ(v, a). (D v ≠ None) ∧ ListMem a (the (D v))) eff
∧ list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') pre) pre
∧ list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') eff) eff"
definition "is_valid_problem_sas_plus Ψ
≡ let ops = operators_of Ψ
; vs = variables_of Ψ
; I = initial_of Ψ
; G = goal_of Ψ
; D = range_of Ψ
in list_all (λv. D v ≠ None) vs
∧ list_all (is_valid_operator_sas_plus Ψ) ops
∧ (∀v. I v ≠ None ⟷ ListMem v vs)
∧ (∀v. I v ≠ None ⟶ ListMem (the (I v)) (the (D v)))
∧ (∀v. G v ≠ None ⟶ ListMem v (variables_of Ψ))
∧ (∀v. G v ≠ None ⟶ ListMem (the (G v)) (the (D v)))"
definition is_operator_applicable_in
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_operator
⇒ bool"
where "is_operator_applicable_in s op
≡ map_of (precondition_of op) ⊆⇩m s"
definition execute_operator_sas_plus
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_operator
⇒ ('variable, 'domain) state" (infixl "⪢⇩+" 52)
where "execute_operator_sas_plus s op ≡ s ++ map_of (effect_of op)"
lemma[simp]:
"is_operator_applicable_in s op = (map_of (precondition_of op) ⊆⇩m s)"
"s ⪢⇩+ op = s ++ map_of (effect_of op)"
unfolding initial_of_def goal_of_def variables_of_def range_of_def operators_of_def
SAS_Plus_Representation.is_operator_applicable_in_def
SAS_Plus_Representation.execute_operator_sas_plus_def
by simp+
lemma range_of_not_empty:
"(sas_plus_problem.range_of Ψ v ≠ None ∧ sas_plus_problem.range_of Ψ v ≠ Some [])
⟷ (ℛ⇩+ Ψ v) ≠ {}"
apply (cases "sas_plus_problem.range_of Ψ v")
by (auto simp add: SAS_Plus_Representation.range_of'_def)
lemma is_valid_operator_sas_plus_then:
fixes Ψ::"('v,'d) sas_plus_problem"
assumes "is_valid_operator_sas_plus Ψ op"
shows "∀(v, a) ∈ set (precondition_of op). v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set (precondition_of op). (ℛ⇩+ Ψ v) ≠ {} ∧ a ∈ ℛ⇩+ Ψ v"
and "∀(v, a) ∈ set (effect_of op). v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set (effect_of op). (ℛ⇩+ Ψ v) ≠ {} ∧ a ∈ ℛ⇩+ Ψ v"
and "∀(v, a) ∈ set (precondition_of op). ∀(v', a') ∈ set (precondition_of op). v ≠ v' ∨ a = a'"
and "∀(v, a) ∈ set (effect_of op).
∀(v', a') ∈ set (effect_of op). v ≠ v' ∨ a = a'"
proof -
let ?vs = "sas_plus_problem.variables_of Ψ"
and ?pre = "precondition_of op"
and ?eff = "effect_of op"
and ?D = "sas_plus_problem.range_of Ψ"
have "∀(v, a)∈set ?pre. v ∈ set ?vs"
and "∀(v, a)∈set ?pre.
(?D v ≠ None) ∧
a ∈ set (the (?D v))"
and "∀(v, a)∈set ?eff. v ∈ set ?vs"
and "∀(v, a)∈set ?eff.
(?D v ≠ None) ∧
a ∈ set (the (?D v))"
and "∀(v, a)∈set ?pre.
∀(v', a')∈set ?pre. v ≠ v' ∨ a = a'"
and "∀(v, a)∈set ?eff.
∀(v', a')∈set ?eff. v ≠ v' ∨ a = a'"
using assms
unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
by meson+
moreover have "∀(v, a) ∈ set ?pre. v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set ?eff. v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set ?pre. ∀(v', a') ∈ set ?pre. v ≠ v' ∨ a = a'"
and "∀(v, a) ∈ set ?eff. ∀(v', a') ∈ set ?eff. v ≠ v' ∨ a = a'"
using calculation
unfolding variables_of_def
by blast+
moreover {
have "∀(v, a) ∈ set ?pre. (?D v ≠ None) ∧ a ∈ set (the (?D v))"
using assms
unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
by argo
hence "∀(v, a) ∈ set ?pre. ((ℛ⇩+ Ψ v) ≠ {}) ∧ a ∈ ℛ⇩+ Ψ v"
using range_of'_def
by fastforce
}
moreover {
have "∀(v, a) ∈ set ?eff. (?D v ≠ None) ∧ a ∈ set (the (?D v))"
using assms
unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
by argo
hence "∀(v, a) ∈ set ?eff. ((ℛ⇩+ Ψ v) ≠ {}) ∧ a ∈ ℛ⇩+ Ψ v"
using range_of'_def
by fastforce
}
ultimately show "∀(v, a) ∈ set (precondition_of op). v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set (precondition_of op). (ℛ⇩+ Ψ v) ≠ {} ∧ a ∈ ℛ⇩+ Ψ v"
and "∀(v, a) ∈ set (effect_of op). v ∈ set ((Ψ)⇩𝒱⇩+)"
and "∀(v, a) ∈ set (effect_of op). (ℛ⇩+ Ψ v) ≠ {} ∧ a ∈ ℛ⇩+ Ψ v"
and "∀(v, a) ∈ set (precondition_of op). ∀(v', a') ∈ set (precondition_of op). v ≠ v' ∨ a = a'"
and "∀(v, a) ∈ set (effect_of op).
∀(v', a') ∈ set (effect_of op). v ≠ v' ∨ a = a'"
by blast+
qed
lemma is_valid_problem_sas_plus_then:
fixes Ψ::"('v,'d) sas_plus_problem"
assumes "is_valid_problem_sas_plus Ψ"
shows "∀v ∈ set ((Ψ)⇩𝒱⇩+). (ℛ⇩+ Ψ v) ≠ {}"
and "∀op ∈ set ((Ψ)⇩𝒪⇩+). is_valid_operator_sas_plus Ψ op"
and "dom ((Ψ)⇩I⇩+) = set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩I⇩+). the (((Ψ)⇩I⇩+) v) ∈ ℛ⇩+ Ψ v"
and "dom ((Ψ)⇩G⇩+) ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩G⇩+). the (((Ψ)⇩G⇩+) v) ∈ ℛ⇩+ Ψ v"
proof -
let ?vs = "sas_plus_problem.variables_of Ψ"
and ?ops = "sas_plus_problem.operators_of Ψ"
and ?I = "sas_plus_problem.initial_of Ψ"
and ?G = "sas_plus_problem.goal_of Ψ"
and ?D = "sas_plus_problem.range_of Ψ"
{
fix v
have "(?D v ≠ None ∧ ?D v ≠ Some []) ⟷ ((ℛ⇩+ Ψ v) ≠ {})"
by (cases "?D v"; (auto simp: range_of'_def))
} note nb = this
have nb⇩1: "∀v ∈ set ?vs. ?D v ≠ None"
and "∀op ∈ set ?ops. is_valid_operator_sas_plus Ψ op"
and "∀v. (?I v ≠ None) = (v ∈ set ?vs)"
and nb⇩2: "∀v. ?I v ≠ None ⟶ the (?I v) ∈ set (the (?D v))"
and "∀v. ?G v ≠ None ⟶ v ∈ set ?vs"
and nb⇩3: "∀v. ?G v ≠ None ⟶ the (?G v) ∈ set (the (?D v))"
using assms
unfolding SAS_Plus_Representation.is_valid_problem_sas_plus_def Let_def
list_all_iff ListMem_iff
by argo+
then have G3: "∀op ∈ set ((Ψ)⇩𝒪⇩+). is_valid_operator_sas_plus Ψ op"
and G4: "dom ((Ψ)⇩I⇩+) = set ((Ψ)⇩𝒱⇩+)"
and G5: "dom ((Ψ)⇩G⇩+) ⊆ set ((Ψ)⇩𝒱⇩+)"
unfolding variables_of_def operators_of_def
by auto+
moreover {
fix v
assume "v ∈ set ((Ψ)⇩𝒱⇩+)"
then have "?D v ≠ None"
using nb⇩1
by force+
} note G6 = this
moreover {
fix v
assume "v ∈ dom ((Ψ)⇩I⇩+)"
moreover have "((Ψ)⇩I⇩+) v ≠ None"
using calculation
by blast+
moreover {
have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using G4 calculation(1)
by argo
then have "sas_plus_problem.range_of Ψ v ≠ None"
using range_of_not_empty
unfolding range_of'_def
using G6
by fast+
hence "set (the (?D v)) = ℛ⇩+ Ψ v"
by (simp add: ‹sas_plus_problem.range_of Ψ v ≠ None› option.case_eq_if range_of'_def)
}
ultimately have "the (((Ψ)⇩I⇩+) v) ∈ ℛ⇩+ Ψ v"
using nb⇩2
by force
}
moreover {
fix v
assume "v ∈ dom ((Ψ)⇩G⇩+)"
then have "((Ψ)⇩G⇩+) v ≠ None"
by blast
moreover {
have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using G5 calculation(1)
by fast
then have "sas_plus_problem.range_of Ψ v ≠ None"
using range_of_not_empty
using G6
by fast+
hence "set (the (?D v)) = ℛ⇩+ Ψ v"
by (simp add: ‹sas_plus_problem.range_of Ψ v ≠ None› option.case_eq_if range_of'_def)
}
ultimately have "the (((Ψ)⇩G⇩+) v) ∈ ℛ⇩+ Ψ v"
using nb⇩3
by auto
}
ultimately show "∀v ∈ set ((Ψ)⇩𝒱⇩+). (ℛ⇩+ Ψ v) ≠ {}"
and "∀op ∈ set((Ψ)⇩𝒪⇩+). is_valid_operator_sas_plus Ψ op"
and "dom ((Ψ)⇩I⇩+) = set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩I⇩+). the (((Ψ)⇩I⇩+) v) ∈ ℛ⇩+ Ψ v"
and "dom ((Ψ)⇩G⇩+) ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩G⇩+). the (((Ψ)⇩G⇩+) v) ∈ ℛ⇩+ Ψ v"
by blast+
qed
end
Theory SAS_Plus_Semantics
theory SAS_Plus_Semantics
imports "SAS_Plus_Representation" "List_Supplement"
"Map_Supplement"
begin
section "SAS+ Semantics"
subsection "Serial Execution Semantics"
text ‹ Serial plan execution is implemented recursively just like in the STRIPS case. By and large,
compared to definition \ref{isadef:plan-execution-strips}, we only substitute the operator
applicability function with its SAS+ counterpart. ›
primrec execute_serial_plan_sas_plus
where "execute_serial_plan_sas_plus s [] = s"
| "execute_serial_plan_sas_plus s (op # ops)
= (if is_operator_applicable_in s op
then execute_serial_plan_sas_plus (execute_operator_sas_plus s op) ops
else s)"
text ‹ Similarly, serial SAS+ solutions are defined just like in STRIPS but based on the
corresponding SAS+ definitions. ›
definition is_serial_solution_for_problem
:: "('variable, 'domain) sas_plus_problem ⇒ ('variable, 'domain) sas_plus_plan ⇒ bool"
where "is_serial_solution_for_problem Ψ ψ
≡ let
I = sas_plus_problem.initial_of Ψ
; G = sas_plus_problem.goal_of Ψ
; ops = sas_plus_problem.operators_of Ψ
in G ⊆⇩m execute_serial_plan_sas_plus I ψ
∧ list_all (λop. ListMem op ops) ψ"
context
begin
private lemma execute_operator_sas_plus_effect_i:
assumes "is_operator_applicable_in s op"
and "∀(v, a) ∈ set (effect_of op). ∀(v', a') ∈ set (effect_of op).
v ≠ v' ∨ a = a'"
and"(v, a) ∈ set (effect_of op)"
shows "(s ⪢⇩+ op) v = Some a"
proof -
let ?effect = "effect_of op"
have "map_of ?effect v = Some a"
using map_of_constant_assignments_defined_if[OF assms(2, 3)] try0
by blast
thus ?thesis
unfolding execute_operator_sas_plus_def map_add_def
by fastforce
qed
private lemma execute_operator_sas_plus_effect_ii:
assumes "is_operator_applicable_in s op"
and "∀(v', a') ∈ set (effect_of op). v' ≠ v"
shows "(s ⪢⇩+ op) v = s v"
proof -
let ?effect = "effect_of op"
{
have "v ∉ fst ` set ?effect"
using assms(2)
by fastforce
then have "v ∉ dom (map_of ?effect)"
using dom_map_of_conv_image_fst[of ?effect]
by argo
hence "(s ++ map_of ?effect) v = s v"
using map_add_dom_app_simps(3)[of v "map_of ?effect" s]
by blast
}
thus ?thesis
by fastforce
qed
text ‹ Given an operator \<^term>‹op› that is applicable in a state \<^term>‹s› and has a consistent set
of effects (second assumption) we can now show that the successor state \<^term>‹s' ≡ s ⪢⇩+ op›
has the following properties:
\begin{itemize}
\item \<^term>‹s' v = Some a› if \<^term>‹(v, a)› exist in \<^term>‹set (effect_of op)›; and,
\item \<^term>‹s' v = s v› if no \<^term>‹(v, a')› exist in \<^term>‹set (effect_of op)›.
\end{itemize}
The second property is the case if the operator doesn't have an effect for a variable \<^term>‹v›. ›
theorem execute_operator_sas_plus_effect:
assumes "is_operator_applicable_in s op"
and "∀(v, a) ∈ set (effect_of op).
∀(v', a') ∈ set (effect_of op). v ≠ v' ∨ a = a'"
shows "(v, a) ∈ set (effect_of op)
⟶ (s ⪢⇩+ op) v = Some a"
and "(∀a. (v, a) ∉ set (effect_of op))
⟶ (s ⪢⇩+ op) v = s v"
proof -
show "(v, a) ∈ set (effect_of op)
⟶ (s ⪢⇩+ op) v = Some a"
using execute_operator_sas_plus_effect_i[OF assms(1, 2)]
by blast
next
show "(∀a. (v, a) ∉ set (effect_of op))
⟶ (s ⪢⇩+ op) v = s v"
using execute_operator_sas_plus_effect_ii[OF assms(1)]
by blast
qed
end
subsection "Parallel Execution Semantics"
type_synonym ('variable, 'domain) sas_plus_parallel_plan
= "('variable, 'domain) sas_plus_operator list list"
definition are_all_operators_applicable_in
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_operator list
⇒ bool"
where "are_all_operators_applicable_in s ops
≡ list_all (is_operator_applicable_in s) ops"
definition are_operator_effects_consistent
:: "('variable, 'domain) sas_plus_operator
⇒ ('variable, 'domain) sas_plus_operator
⇒ bool"
where "are_operator_effects_consistent op op'
≡ let
effect = effect_of op
; effect' = effect_of op'
in list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') effect') effect"
definition are_all_operator_effects_consistent
:: "('variable, 'domain) sas_plus_operator list
⇒ bool"
where "are_all_operator_effects_consistent ops
≡ list_all (λop. list_all (are_operator_effects_consistent op) ops) ops"
definition execute_parallel_operator_sas_plus
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_operator list
⇒ ('variable, 'domain) state"
where "execute_parallel_operator_sas_plus s ops
≡ foldl (++) s (map (map_of ∘ effect_of) ops)"
text ‹ We now define parallel execution and parallel traces for SAS+ by lifting the tests for
applicability and effect consistency to parallel SAS+ operators. The definitions are again very
similar to their STRIPS analogs (definitions \ref{isadef:parallel-plan-execution-strips} and
\ref{isadef:parallel-plan-trace-strips}). ›
fun execute_parallel_plan_sas_plus
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_parallel_plan
⇒ ('variable, 'domain) state"
where "execute_parallel_plan_sas_plus s [] = s"
| "execute_parallel_plan_sas_plus s (ops # opss) = (if
are_all_operators_applicable_in s ops
∧ are_all_operator_effects_consistent ops
then execute_parallel_plan_sas_plus
(execute_parallel_operator_sas_plus s ops) opss
else s)"
fun trace_parallel_plan_sas_plus
:: "('variable, 'domain) state
⇒ ('variable, 'domain) sas_plus_parallel_plan
⇒ ('variable, 'domain) state list"
where "trace_parallel_plan_sas_plus s [] = [s]"
| "trace_parallel_plan_sas_plus s (ops # opss) = s # (if
are_all_operators_applicable_in s ops
∧ are_all_operator_effects_consistent ops
then trace_parallel_plan_sas_plus
(execute_parallel_operator_sas_plus s ops) opss
else [])"
text ‹ A plan \<^term>‹ψ› is a solution for a SAS+ problem \<^term>‹Ψ› if
\begin{enumerate}
\item starting from the initial state \<^term>‹Ψ›, SAS+ parallel plan execution
reaches a state which satisfies the described goal state \<^term>‹sas_plus_problem.goal_of Ψ›; and,
\item all parallel operators \<^term>‹ops› in the plan \<^term>‹ψ› only consist of operators that
are specified in the problem description.
\end{enumerate} ›
definition is_parallel_solution_for_problem
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable, 'domain) sas_plus_parallel_plan
⇒ bool"
where "is_parallel_solution_for_problem Ψ ψ
≡ let
G = sas_plus_problem.goal_of Ψ
; I = sas_plus_problem.initial_of Ψ
; Ops = sas_plus_problem.operators_of Ψ
in G ⊆⇩m execute_parallel_plan_sas_plus I ψ
∧ list_all (λops. list_all (λop. ListMem op Ops) ops) ψ"
context
begin
lemma execute_parallel_operator_sas_plus_cons[simp]:
"execute_parallel_operator_sas_plus s (op # ops)
= execute_parallel_operator_sas_plus (s ++ map_of (effect_of op)) ops"
unfolding execute_parallel_operator_sas_plus_def
by simp
text ‹The following lemmas show the properties of SAS+ parallel plan execution traces.
The results are analogous to those for STRIPS. So, let \<^term>‹τ ≡ trace_parallel_plan_sas_plus I ψ›
be a trace of a parallel SAS+ plan \<^term>‹ψ› with initial state \<^term>‹I›, then
\begin{itemize}
\item the head of the trace \<^term>‹τ ! 0› is the initial state of the
problem (lemma \ref{isathm:head-parallel-plan-trace-sas-plus}); moreover,
\item for all but the last element of the trace---i.e. elements with index
\<^term>‹k < length τ - 1›---the parallel operator \<^term>‹π ! k› is executable (lemma
\ref{isathm:parallel-plan-trace-operator-execution-conditions-sas-plus}); and
finally,
\item for all \<^term>‹k < length τ›, the parallel execution of the plan prefix \<^term>‹take k ψ› with
initial state \<^term>‹I› equals the \<^term>‹k›-th element of the trace \<^term>‹τ ! k› (lemma
\ref{isathm:parallel-trace-plan-prefixes-sas-plus}).
\end{itemize} ›
lemma trace_parallel_plan_sas_plus_head_is_initial_state:
"trace_parallel_plan_sas_plus I ψ ! 0 = I"
proof (cases ψ)
case (Cons a list)
then show ?thesis
by (cases "are_all_operators_applicable_in I a ∧ are_all_operator_effects_consistent a";
simp+)
qed simp
lemma trace_parallel_plan_sas_plus_length_gt_one_if:
assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1"
shows "1 < length (trace_parallel_plan_sas_plus I ψ)"
using assms
by linarith
lemma length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one:
shows "length (trace_parallel_plan_sas_plus I ψ) ≤ length ψ + 1"
proof (induction ψ arbitrary: I)
case (Cons a ψ)
then show ?case
proof (cases "are_all_operators_applicable_in I a ∧ are_all_operator_effects_consistent a")
case True
let ?I' = "execute_parallel_operator_sas_plus I a"
{
have "trace_parallel_plan_sas_plus I (a # ψ) = I # trace_parallel_plan_sas_plus ?I' ψ"
using True
by auto
then have "length (trace_parallel_plan_sas_plus I (a # ψ))
= length (trace_parallel_plan_sas_plus ?I' ψ) + 1"
by simp
moreover have "length (trace_parallel_plan_sas_plus ?I' ψ) ≤ length ψ + 1"
using Cons.IH[of ?I']
by blast
ultimately have "length (trace_parallel_plan_sas_plus I (a # ψ)) ≤ length (a # ψ) + 1"
by simp
}
thus ?thesis
by blast
qed auto
qed simp
lemma plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements:
assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1"
obtains ops ψ' where "ψ = ops # ψ'"
proof -
let ?τ = "trace_parallel_plan_sas_plus I ψ"
have "length ?τ ≤ length ψ + 1"
using length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one
by fast
then have "0 < length ψ"
using trace_parallel_plan_sas_plus_length_gt_one_if[OF assms]
by fastforce
then obtain k' where "length ψ = Suc k'"
using gr0_implies_Suc
by meson
thus ?thesis using that
using length_Suc_conv[of ψ k']
by blast
qed
lemma trace_parallel_plan_sas_plus_step_implies_operator_execution_condition_holds:
assumes "k < length (trace_parallel_plan_sas_plus I π) - 1"
shows "are_all_operators_applicable_in (trace_parallel_plan_sas_plus I π ! k) (π ! k)
∧ are_all_operator_effects_consistent (π ! k)"
using assms
proof (induction "π" arbitrary: I k)
case (Cons a π)
then show ?case
proof (cases "are_all_operators_applicable_in I a ∧ are_all_operator_effects_consistent a")
case True
have trace_parallel_plan_sas_plus_cons: "trace_parallel_plan_sas_plus I (a # π)
= I # trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π"
using True
by simp
then show ?thesis
proof (cases "k")
case 0
have "trace_parallel_plan_sas_plus I (a # π) ! 0 = I"
using trace_parallel_plan_sas_plus_cons
by simp
moreover have "(a # π) ! 0 = a"
by simp
ultimately show ?thesis
using True 0
by presburger
next
case (Suc k')
have "trace_parallel_plan_sas_plus I (a # π) ! Suc k'
= trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π ! k'"
using trace_parallel_plan_sas_plus_cons
by simp
moreover have "(a # π) ! Suc k' = π ! k'"
by simp
moreover {
let ?I' = "execute_parallel_operator_sas_plus I a"
have "length (trace_parallel_plan_sas_plus I (a # π))
= 1 + length (trace_parallel_plan_sas_plus ?I' π)"
using trace_parallel_plan_sas_plus_cons
by auto
then have "k' < length (trace_parallel_plan_sas_plus ?I' π) - 1"
using Cons.prems Suc
unfolding Suc_eq_plus1
by fastforce
hence "are_all_operators_applicable_in
(trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π ! k')
(π ! k')
∧ are_all_operator_effects_consistent (π ! k')"
using Cons.IH[of k' "execute_parallel_operator_sas_plus I a"] Cons.prems Suc trace_parallel_plan_sas_plus_cons
by simp
}
ultimately show ?thesis
using Suc
by argo
qed
next
case False
then have "trace_parallel_plan_sas_plus I (a # π) = [I]"
by force
then have "length (trace_parallel_plan_sas_plus I (a # π)) - 1 = 0"
by simp
then show ?thesis
using Cons.prems
by force
qed
qed auto
lemma trace_parallel_plan_sas_plus_prefix:
assumes "k < length (trace_parallel_plan_sas_plus I ψ)"
shows "trace_parallel_plan_sas_plus I ψ ! k = execute_parallel_plan_sas_plus I (take k ψ)"
using assms
proof (induction ψ arbitrary: I k)
case (Cons a ψ)
then show ?case
proof (cases "are_all_operators_applicable_in I a ∧ are_all_operator_effects_consistent a")
case True
let ?σ = "trace_parallel_plan_sas_plus I (a # ψ)"
and ?I' = "execute_parallel_operator_sas_plus I a"
have σ_equals: "?σ = I # trace_parallel_plan_sas_plus ?I' ψ"
using True
by auto
then show ?thesis
proof (cases "k = 0")
case False
obtain k' where k_is_suc_of_k': "k = Suc k'"
using not0_implies_Suc[OF False]
by blast
then have "execute_parallel_plan_sas_plus I (take k (a # ψ))
= execute_parallel_plan_sas_plus ?I' (take k' ψ)"
using True
by simp
moreover have "trace_parallel_plan_sas_plus I (a # ψ) ! k
= trace_parallel_plan_sas_plus ?I' ψ ! k'"
using σ_equals k_is_suc_of_k'
by simp
moreover {
have "k' < length (trace_parallel_plan_sas_plus ?I' ψ)"
using Cons.prems σ_equals k_is_suc_of_k'
by force
hence "trace_parallel_plan_sas_plus ?I' ψ ! k'
= execute_parallel_plan_sas_plus ?I' (take k' ψ)"
using Cons.IH[of k' ?I']
by blast
}
ultimately show ?thesis
by presburger
qed simp
next
case operator_precondition_violated: False
then show ?thesis
proof (cases "k = 0")
case False
then have "trace_parallel_plan_sas_plus I (a # ψ) = [I]"
using operator_precondition_violated
by force
moreover have "execute_parallel_plan_sas_plus I (take k (a # ψ)) = I"
using Cons.prems operator_precondition_violated
by force
ultimately show ?thesis
using Cons.prems nth_Cons_0
by auto
qed simp
qed
qed simp
lemma trace_parallel_plan_sas_plus_step_effect_is:
assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1"
shows "trace_parallel_plan_sas_plus I ψ ! Suc k
= execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! k) (ψ ! k)"
proof -
let ?τ = "trace_parallel_plan_sas_plus I ψ"
let ?τ⇩k = "?τ ! k"
and ?τ⇩k' = "?τ ! Suc k"
{
have suc_k_lt_length_τ: "Suc k < length ?τ"
using assms
by linarith
hence "?τ⇩k' = execute_parallel_plan_sas_plus I (take (Suc k) ψ)"
using trace_parallel_plan_sas_plus_prefix[of "Suc k"]
by blast
} note rewrite_goal = this
have "execute_parallel_plan_sas_plus I (take (Suc k) ψ)
= execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! k) (ψ ! k)"
using assms
proof (induction k arbitrary: I ψ)
case 0
obtain ops ψ' where ψ_is: "ψ = ops # ψ'"
using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF "0.prems"]
by force
{
have "take (Suc 0) ψ = [ψ ! 0]"
using ψ_is
by simp
hence "execute_parallel_plan_sas_plus I (take (Suc 0) ψ)
= execute_parallel_plan_sas_plus I [ψ ! 0]"
by argo
}
moreover {
have "trace_parallel_plan_sas_plus I ψ ! 0 = I"
using trace_parallel_plan_sas_plus_head_is_initial_state.
moreover {
have "are_all_operators_applicable_in I (ψ ! 0)"
and "are_all_operator_effects_consistent (ψ ! 0)"
using trace_parallel_plan_sas_plus_step_implies_operator_execution_condition_holds[OF
"0.prems"] calculation
by argo+
then have "execute_parallel_plan_sas_plus I [ψ ! 0]
= execute_parallel_operator_sas_plus I (ψ ! 0)"
by simp
}
ultimately have "execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! 0)
(ψ ! 0)
= execute_parallel_plan_sas_plus I [ψ ! 0]"
by argo
}
ultimately show ?case
by argo
next
case (Suc k)
obtain ops ψ' where ψ_is: "ψ = ops # ψ'"
using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF Suc.prems]
by blast
let ?I' = "execute_parallel_operator_sas_plus I ops"
have "execute_parallel_plan_sas_plus I (take (Suc (Suc k)) ψ)
= execute_parallel_plan_sas_plus ?I' (take (Suc k) ψ')"
using Suc.prems ψ_is
by fastforce
moreover {
thm Suc.IH[of ]
have "length (trace_parallel_plan_sas_plus I ψ)
= 1 + length (trace_parallel_plan_sas_plus ?I' ψ')"
using ψ_is Suc.prems
by fastforce
moreover have "k < length (trace_parallel_plan_sas_plus ?I' ψ') - 1"
using Suc.prems calculation
by fastforce
ultimately have "execute_parallel_plan_sas_plus ?I' (take (Suc k) ψ') =
execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus ?I' ψ' ! k)
(ψ' ! k)"
using Suc.IH[of ?I' ψ']
by blast
}
moreover have "execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus ?I' ψ' ! k)
(ψ' ! k)
= execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! Suc k)
(ψ ! Suc k)"
using Suc.prems ψ_is
by auto
ultimately show ?case
by argo
qed
thus ?thesis
using rewrite_goal
by argo
qed
text ‹ Finally, we obtain the result corresponding to lemma
\ref{isathm:parallel-solution-trace-strips} in the SAS+ case: it is equivalent to say that parallel
SAS+ execution reaches the problem's goal state and that the last element of the corresponding
trace satisfies the goal state. ›
lemma execute_parallel_plan_sas_plus_reaches_goal_iff_goal_is_last_element_of_trace:
"G ⊆⇩m execute_parallel_plan_sas_plus I ψ
⟷ G ⊆⇩m last (trace_parallel_plan_sas_plus I ψ)"
proof -
let ?τ = "trace_parallel_plan_sas_plus I ψ"
show ?thesis
proof (rule iffI)
assume "G ⊆⇩m execute_parallel_plan_sas_plus I ψ"
thus "G ⊆⇩m last ?τ"
proof (induction ψ arbitrary: I)
case (Cons ops ψ)
show ?case
proof (cases "are_all_operators_applicable_in I ops
∧ are_all_operator_effects_consistent ops")
case True
let ?s = "execute_parallel_operator_sas_plus I ops"
{
have "G ⊆⇩m execute_parallel_plan_sas_plus ?s ψ"
using True Cons.prems
by simp
hence "G ⊆⇩m last (trace_parallel_plan_sas_plus ?s ψ)"
using Cons.IH
by auto
}
moreover {
have "trace_parallel_plan_sas_plus I (ops # ψ)
= I # trace_parallel_plan_sas_plus ?s ψ"
using True
by simp
moreover have "trace_parallel_plan_sas_plus ?s ψ ≠ []"
using trace_parallel_plan_sas_plus.elims
by blast
ultimately have "last (trace_parallel_plan_sas_plus I (ops # ψ))
= last (trace_parallel_plan_sas_plus ?s ψ)"
using last_ConsR
by simp
}
ultimately show ?thesis
by argo
next
case False
then have "G ⊆⇩m I"
using Cons.prems
by force
thus ?thesis
using False
by force
qed
qed force
next
assume "G ⊆⇩m last ?τ"
thus "G ⊆⇩m execute_parallel_plan_sas_plus I ψ"
proof (induction ψ arbitrary: I)
case (Cons ops ψ)
thus ?case
proof (cases "are_all_operators_applicable_in I ops
∧ are_all_operator_effects_consistent ops")
case True
let ?s = "execute_parallel_operator_sas_plus I ops"
{
have "trace_parallel_plan_sas_plus I (ops # ψ)
= I # trace_parallel_plan_sas_plus ?s ψ"
using True
by simp
moreover have "trace_parallel_plan_sas_plus ?s ψ ≠ []"
using trace_parallel_plan_sas_plus.elims
by blast
ultimately have "last (trace_parallel_plan_sas_plus I (ops # ψ))
= last (trace_parallel_plan_sas_plus ?s ψ)"
using last_ConsR
by simp
hence "G ⊆⇩m execute_parallel_plan_sas_plus ?s ψ"
using Cons.IH[of ?s] Cons.prems
by argo
}
moreover have "execute_parallel_plan_sas_plus I (ops # ψ)
= execute_parallel_plan_sas_plus ?s ψ"
using True
by force
ultimately show ?thesis
by argo
next
case False
have "G ⊆⇩m I"
using Cons.prems False
by simp
thus ?thesis
using False
by force
qed
qed simp
qed
qed
lemma is_parallel_solution_for_problem_plan_operator_set:
fixes Ψ :: "('v, 'd) sas_plus_problem"
assumes "is_parallel_solution_for_problem Ψ ψ"
shows "∀ops ∈ set ψ. ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff operators_of_def
by presburger
end
subsection "Serializable Parallel Plans"
text ‹ Again we want to establish conditions for the serializability of plans. Let
\<^term>‹Ψ› be a SAS+ problem instance and let \<^term>‹ψ› be a serial solution. We obtain the following
two important results, namely that
\begin{enumerate}
\item the embedding \<^term>‹embed ψ› of \<^term>‹ψ› is a parallel solution for \<^term>‹Ψ›
(lemma \ref{isathm:serial-sas-plus-embedding}); and conversely that,
\item a parallel solution to \<^term>‹Ψ› that has the form of an embedded serial plan can be
concatenated to obtain a serial solution (lemma
\ref{isathm:embedded-serial-solution-flattening-sas-plus}).
\end{enumerate} ›
context
begin
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i:
assumes "is_operator_applicable_in s op"
"are_operator_effects_consistent op op"
shows "s ⪢⇩+ op = execute_parallel_operator_sas_plus s [op]"
proof -
have "are_all_operators_applicable_in s [op]"
unfolding are_all_operators_applicable_in_def
SAS_Plus_Representation.execute_operator_sas_plus_def
is_operator_applicable_in_def SAS_Plus_Representation.is_operator_applicable_in_def
list_all_iff
using assms(1)
by fastforce
moreover have "are_all_operator_effects_consistent [op]"
unfolding are_all_operator_effects_consistent_def list_all_iff
using assms(2)
by fastforce
ultimately show ?thesis
unfolding execute_parallel_operator_sas_plus_def execute_operator_sas_plus_def
by simp
qed
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii:
fixes I :: "('variable, 'domain) state"
assumes "∀op ∈ set ψ. are_operator_effects_consistent op op"
and "G ⊆⇩m execute_serial_plan_sas_plus I ψ"
shows "G ⊆⇩m execute_parallel_plan_sas_plus I (embed ψ)"
using assms
proof (induction ψ arbitrary: I)
case (Cons op ψ)
show ?case
proof (cases "are_all_operators_applicable_in I [op]")
case True
let ?J = "execute_operator_sas_plus I op"
let ?J' = "execute_parallel_operator_sas_plus I [op]"
have "SAS_Plus_Representation.is_operator_applicable_in I op"
using True
unfolding are_all_operators_applicable_in_def list_all_iff
by force
moreover have "G ⊆⇩m execute_serial_plan_sas_plus ?J ψ"
using Cons.prems(2) calculation(1)
by simp
moreover have "are_all_operator_effects_consistent [op]"
unfolding are_all_operator_effects_consistent_def list_all_iff Let_def
using Cons.prems(1)
by simp
moreover have "execute_parallel_plan_sas_plus I ([op] # embed ψ)
= execute_parallel_plan_sas_plus ?J' (embed ψ)"
using True calculation(3)
by simp
moreover {
have "is_operator_applicable_in I op"
"are_operator_effects_consistent op op"
using True Cons.prems(1)
unfolding are_all_operators_applicable_in_def
SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff
by fastforce+
hence "?J = ?J'"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i
calculation(1)
by blast
}
ultimately show ?thesis
using Cons.IH[of ?J] Cons.prems(1)
by simp
next
case False
moreover have "¬is_operator_applicable_in I op"
using calculation
unfolding are_all_operators_applicable_in_def
SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff
by fastforce
moreover have "G ⊆⇩m I"
using Cons.prems(2) calculation(2)
unfolding is_operator_applicable_in_def
by simp
moreover have "execute_parallel_plan_sas_plus I ([op] # embed ψ) = I"
using calculation(1)
by fastforce
ultimately show ?thesis
by force
qed
qed simp
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii:
assumes "is_valid_problem_sas_plus Ψ"
and "is_serial_solution_for_problem Ψ ψ"
and "op ∈ set ψ"
shows "are_operator_effects_consistent op op"
proof -
have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(2) assms(3)
unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
by fastforce
then have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1, 3)
by auto
thus ?thesis
unfolding are_operator_effects_consistent_def Let_def list_all_iff ListMem_iff
using is_valid_operator_sas_plus_then(6)
by fast
qed
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv:
fixes Ψ :: "('v, 'd) sas_plus_problem"
assumes "∀op ∈ set ψ. op ∈ set ((Ψ)⇩𝒪⇩+)"
shows "∀ops ∈ set (embed ψ). ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
proof -
let ?ψ' = "embed ψ"
have nb: "set ?ψ' = { [op] | op. op ∈ set ψ }"
by (induction ψ; force)
{
fix ops
assume "ops ∈ set ?ψ'"
moreover obtain op where "ops = [op]" and "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(1) nb calculation
by blast
ultimately have "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
by fastforce
}
thus ?thesis..
qed
theorem execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus:
assumes "is_valid_problem_sas_plus Ψ"
and "is_serial_solution_for_problem Ψ ψ"
shows "is_parallel_solution_for_problem Ψ (embed ψ)"
proof -
let ?ops = "sas_plus_problem.operators_of Ψ"
and ?ψ' = "embed ψ"
{
thm execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii[OF]
have "(Ψ)⇩G⇩+ ⊆⇩m execute_serial_plan_sas_plus ((Ψ)⇩I⇩+) ψ"
using assms(2)
unfolding is_serial_solution_for_problem_def Let_def
by simp
moreover have "∀op ∈ set ψ. are_operator_effects_consistent op op"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii[OF assms]..
ultimately have "(Ψ)⇩G⇩+ ⊆⇩m execute_parallel_plan_sas_plus ((Ψ)⇩I⇩+) ?ψ'"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii
by blast
}
moreover {
have "∀op ∈ set ψ. op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(2)
unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
by fastforce
hence "∀ops ∈ set ?ψ'. ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv
by blast
}
ultimately show ?thesis
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff Let_def goal_of_def
initial_of_def
by fastforce
qed
lemma flattening_lemma_i:
fixes Ψ :: "('v, 'd) sas_plus_problem"
assumes "∀ops ∈ set π. ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
shows "∀op ∈ set (concat π). op ∈ set ((Ψ)⇩𝒪⇩+)"
proof -
{
fix op
assume "op ∈ set (concat π)"
moreover have "op ∈ (⋃ops ∈ set π. set ops)"
using calculation
unfolding set_concat.
then obtain ops where "ops ∈ set π" and "op ∈ set ops"
using UN_iff
by blast
ultimately have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms
by blast
}
thus ?thesis..
qed
lemma flattening_lemma_ii:
fixes I :: "('variable, 'domain) state"
assumes "∀ops ∈ set ψ. ∃op. ops = [op] ∧ is_valid_operator_sas_plus Ψ op "
and "G ⊆⇩m execute_parallel_plan_sas_plus I ψ"
shows "G ⊆⇩m execute_serial_plan_sas_plus I (concat ψ)"
proof -
show ?thesis
using assms
proof (induction ψ arbitrary: I)
case (Cons ops ψ)
obtain op where ops_is: "ops = [op]" and is_valid_op: "is_valid_operator_sas_plus Ψ op"
using Cons.prems(1)
by auto
then show ?case
proof (cases "are_all_operators_applicable_in I ops")
case True
let ?J = "execute_parallel_operator_sas_plus I [op]"
and ?J' = "execute_operator_sas_plus I op"
have nb⇩1: "is_operator_applicable_in I op"
using True ops_is
unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def
list_all_iff
by force
have nb⇩2: "are_operator_effects_consistent op op"
unfolding are_operator_effects_consistent_def list_all_iff Let_def
using is_valid_operator_sas_plus_then(6)[OF is_valid_op]
by blast
have "are_all_operator_effects_consistent ops"
using ops_is
unfolding are_all_operator_effects_consistent_def list_all_iff
using nb⇩2
by force
moreover have "G ⊆⇩m execute_parallel_plan_sas_plus ?J ψ"
using Cons.prems(2) True calculation ops_is
by fastforce
moreover have "execute_serial_plan_sas_plus I (concat (ops # ψ))
= execute_serial_plan_sas_plus ?J' (concat ψ)"
using ops_is nb⇩1 is_operator_applicable_in_def
by simp
moreover have "?J = ?J'"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i[OF nb⇩1 nb⇩2]
by simp
ultimately show ?thesis
using Cons.IH[of ?J] Cons.prems(1)
by force
next
case False
moreover have "G ⊆⇩m I"
using Cons.prems(2) calculation
by fastforce
moreover {
have "¬is_operator_applicable_in I op"
using False ops_is
unfolding are_all_operators_applicable_in_def
is_operator_applicable_in_def list_all_iff
by force
moreover have "execute_serial_plan_sas_plus I (concat (ops # ψ))
= execute_serial_plan_sas_plus I (op # concat ψ)"
using ops_is
by force
ultimately have "execute_serial_plan_sas_plus I (concat (ops # ψ)) = I"
using False
unfolding is_operator_applicable_in_def
by fastforce
}
ultimately show ?thesis
by argo
qed
qed force
qed
lemma flattening_lemma:
assumes "is_valid_problem_sas_plus Ψ"
and "∀ops ∈ set ψ. ∃op. ops = [op]"
and "is_parallel_solution_for_problem Ψ ψ"
shows "is_serial_solution_for_problem Ψ (concat ψ)"
proof -
let ?ψ' = "concat ψ"
{
have "∀ops ∈ set ψ. ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(3)
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
by force
hence "∀op ∈ set ?ψ'. op ∈ set ((Ψ)⇩𝒪⇩+)"
using flattening_lemma_i
by blast
}
moreover {
{
fix ops
assume "ops ∈ set ψ"
moreover obtain op where "ops = [op]"
using assms(2) calculation
by blast
moreover have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(3) calculation
unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
by force
moreover have "is_valid_operator_sas_plus Ψ op"
using assms(1) calculation(3)
unfolding is_valid_problem_sas_plus_def Let_def list_all_iff
ListMem_iff
by simp
ultimately have "∃op. ops = [op] ∧ is_valid_operator_sas_plus Ψ op"
by blast
}
moreover have "(Ψ)⇩G⇩+ ⊆⇩m execute_parallel_plan_sas_plus ((Ψ)⇩I⇩+) ψ"
using assms(3)
unfolding is_parallel_solution_for_problem_def
by fastforce
ultimately have "(Ψ)⇩G⇩+ ⊆⇩m execute_serial_plan_sas_plus ((Ψ)⇩I⇩+) ?ψ'"
using flattening_lemma_ii
by blast
}
ultimately show "is_serial_solution_for_problem Ψ ?ψ'"
unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff
by fastforce
qed
end
subsection "Auxiliary lemmata on SAS+"
context
begin
lemma is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op:
assumes "is_valid_operator_sas_plus Ψ op"
and "(v, a) ∈ set (precondition_of op) ∨ (v, a) ∈ set (effect_of op)"
shows "(ℛ⇩+ Ψ v) = set (the (sas_plus_problem.range_of Ψ v))"
proof -
consider (A) "(v, a) ∈ set (precondition_of op)"
| (B) "(v, a) ∈ set (effect_of op)"
using assms(2)..
thus ?thesis
proof (cases)
case A
then have "(ℛ⇩+ Ψ v) ≠ {}" and "a ∈ ℛ⇩+ Ψ v"
using assms
unfolding range_of_def
using is_valid_operator_sas_plus_then(2)
by fast+
thus ?thesis
unfolding range_of'_def option.case_eq_if
by auto
next
case B
then have "(ℛ⇩+ Ψ v) ≠ {}" and "a ∈ ℛ⇩+ Ψ v"
using assms
unfolding range_of_def
using is_valid_operator_sas_plus_then(4)
by fast+
thus ?thesis
unfolding range_of'_def option.case_eq_if
by auto
qed
qed
lemma set_the_range_of_is_range_of_sas_plus_if:
fixes Ψ :: "('v, 'd) sas_plus_problem"
assumes "is_valid_problem_sas_plus Ψ"
"v ∈ set ((Ψ)⇩𝒱⇩+)"
shows "set (the (sas_plus_problem.range_of Ψ v)) = ℛ⇩+ Ψ v"
proof-
have "v ∈ set((Ψ)⇩𝒱⇩+)"
using assms(2)
unfolding variables_of_def.
moreover have "(ℛ⇩+ Ψ v) ≠ {}"
using assms(1) calculation is_valid_problem_sas_plus_then(1)
by blast
moreover have "sas_plus_problem.range_of Ψ v ≠ None"
and "sas_plus_problem.range_of Ψ v ≠ Some []"
using calculation(2) range_of_not_empty
unfolding range_of_def
by fast+
ultimately show ?thesis
unfolding option.case_eq_if range_of'_def
by force
qed
lemma sublocale_sas_plus_finite_domain_representation_ii:
fixes Ψ::"('v,'d) sas_plus_problem"
assumes "is_valid_problem_sas_plus Ψ"
shows "∀v ∈ set ((Ψ)⇩𝒱⇩+). (ℛ⇩+ Ψ v) ≠ {}"
and "∀op ∈ set ((Ψ)⇩𝒪⇩+). is_valid_operator_sas_plus Ψ op"
and "dom ((Ψ)⇩I⇩+) = set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩I⇩+). the (((Ψ)⇩I⇩+) v) ∈ ℛ⇩+ Ψ v"
and "dom ((Ψ)⇩G⇩+) ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom ((Ψ)⇩G⇩+). the (((Ψ)⇩G⇩+) v) ∈ ℛ⇩+ Ψ v"
using is_valid_problem_sas_plus_then[OF assms]
by auto
end
end
Theory SAS_Plus_STRIPS
theory SAS_Plus_STRIPS
imports "STRIPS_Semantics" "SAS_Plus_Semantics"
"Map_Supplement"
begin
section "SAS+/STRIPS Equivalence"
text ‹ The following part is concerned with showing the equivalent expressiveness of SAS+ and
STRIPS as discussed in \autoref{sub:equivalence-sas-plus-strips}. ›
subsection "Translation of SAS+ Problems to STRIPS Problems"
definition possible_assignments_for
:: "('variable, 'domain) sas_plus_problem ⇒ 'variable ⇒ ('variable × 'domain) list"
where "possible_assignments_for Ψ v ≡ [(v, a). a ← the (range_of Ψ v)]"
definition all_possible_assignments_for
:: "('variable, 'domain) sas_plus_problem ⇒ ('variable × 'domain) list"
where "all_possible_assignments_for Ψ
≡ concat [possible_assignments_for Ψ v. v ← variables_of Ψ]"
definition state_to_strips_state
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable, 'domain) state
⇒ ('variable, 'domain) assignment strips_state"
("φ⇩S _ _" 99)
where "state_to_strips_state Ψ s
≡ let defined = filter (λv. s v ≠ None) (variables_of Ψ) in
map_of (map (λ(v, a). ((v, a), the (s v) = a))
(concat [possible_assignments_for Ψ v. v ← defined]))"
definition sasp_op_to_strips
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable, 'domain) sas_plus_operator
⇒ ('variable, 'domain) assignment strips_operator"
("φ⇩O _ _" 99)
where "sasp_op_to_strips Ψ op ≡ let
pre = precondition_of op
; add = effect_of op
; delete = [(v, a'). (v, a) ← effect_of op, a' ← filter ((≠) a) (the (range_of Ψ v))]
in STRIPS_Representation.operator_for pre add delete"
definition sas_plus_problem_to_strips_problem
:: "('variable, 'domain) sas_plus_problem ⇒ ('variable, 'domain) assignment strips_problem"
("φ _ " 99)
where "sas_plus_problem_to_strips_problem Ψ ≡ let
vs = [as. v ← variables_of Ψ, as ← (possible_assignments_for Ψ) v]
; ops = map (sasp_op_to_strips Ψ) (operators_of Ψ)
; I = state_to_strips_state Ψ (initial_of Ψ)
; G = state_to_strips_state Ψ (goal_of Ψ)
in STRIPS_Representation.problem_for vs ops I G"
definition sas_plus_parallel_plan_to_strips_parallel_plan
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable, 'domain) sas_plus_parallel_plan
⇒ ('variable × 'domain) strips_parallel_plan"
("φ⇩P _ _" 99)
where "sas_plus_parallel_plan_to_strips_parallel_plan Ψ ψ
≡ [[sasp_op_to_strips Ψ op. op ← ops]. ops ← ψ]"
definition strips_state_to_state
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable, 'domain) assignment strips_state
⇒ ('variable, 'domain) state"
("φ⇩S¯ _ _" 99)
where "strips_state_to_state Ψ s
≡ map_of (filter (λ(v, a). s (v, a) = Some True) (all_possible_assignments_for Ψ))"
definition strips_op_to_sasp
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable × 'domain) strips_operator
⇒ ('variable, 'domain) sas_plus_operator"
("φ⇩O¯ _ _" 99)
where "strips_op_to_sasp Ψ op
≡ let
precondition = strips_operator.precondition_of op
; effect = strips_operator.add_effects_of op
in ⦇ precondition_of = precondition, effect_of = effect ⦈"
definition strips_parallel_plan_to_sas_plus_parallel_plan
:: "('variable, 'domain) sas_plus_problem
⇒ ('variable × 'domain) strips_parallel_plan
⇒ ('variable, 'domain) sas_plus_parallel_plan"
("φ⇩P¯ _ _" 99)
where "strips_parallel_plan_to_sas_plus_parallel_plan Π π
≡ [[strips_op_to_sasp Π op. op ← ops]. ops ← π]"
text ‹ To set up the equivalence proof context, we declare a common locale
\isaname{sas_plus_strips_equivalence} for both the STRIPS and SAS+ formalisms and make it a
sublocale of both locale \isaname{strips} as well as \isaname{sas_plus}.
The declaration itself is omitted for brevity since it basically just joins locales
\isaname{sas_plus} and \isaname{strips} while renaming the locale parameter to avoid name clashes.
The sublocale proofs are shown below.
\footnote{We append a suffix identifying the respective formalism to the the parameter names
passed to the parameter names in the locale. This is necessary to avoid ambiguous names in the
sublocale declarations. For example, without addition of suffixes the type for ‹initial_of› is
ambiguous and will therefore not be bound to either ‹strips_problem.initial_of› or
‹sas_plus_problem.initial_of›.
Isabelle in fact considers it to be a a free variable in this case. We also qualify the parent
locales in the sublocale declarations by adding \texttt{strips:} and \texttt{sas\_plus:} before
the respective parent locale identifiers. } ›
definition "range_of_strips Π x ≡ { True, False }"
context
begin
lemma[simp]:
"(φ Ψ) = (let
vs = [as. v ← variables_of Ψ, as ← (possible_assignments_for Ψ) v]
; ops = map (sasp_op_to_strips Ψ) (operators_of Ψ)
; I = state_to_strips_state Ψ (initial_of Ψ)
; G = state_to_strips_state Ψ (goal_of Ψ)
in STRIPS_Representation.problem_for vs ops I G)"
and "(φ⇩S Ψ s)
= (let defined = filter (λv. s v ≠ None) (variables_of Ψ) in
map_of (map (λ(v, a). ((v, a), the (s v) = a))
(concat [possible_assignments_for Ψ v. v ← defined])))"
and "(φ⇩O Ψ op)
= (let
pre = precondition_of op
; add = effect_of op
; delete = [(v, a'). (v, a) ← effect_of op, a' ← filter ((≠) a) (the (range_of Ψ v))]
in STRIPS_Representation.operator_for pre add delete)"
and "(φ⇩P Ψ ψ) = [[φ⇩O Ψ op. op ← ops]. ops ← ψ]"
and "(φ⇩S¯ Ψ s')= map_of (filter (λ(v, a). s' (v, a) = Some True)
(all_possible_assignments_for Ψ))"
and "(φ⇩O¯ Ψ op') = (let
precondition = strips_operator.precondition_of op'
; effect = strips_operator.add_effects_of op'
in ⦇ precondition_of = precondition, effect_of = effect ⦈)"
and "(φ⇩P¯ Ψ π) = [[φ⇩O¯ Ψ op. op ← ops]. ops ← π]"
unfolding
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.state_to_strips_state_def
state_to_strips_state_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.strips_state_to_state_def
strips_state_to_state_def
SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_parallel_plan_to_sas_plus_parallel_plan_def
by blast+
lemmas [simp] = range_of'_def
lemma is_valid_problem_sas_plus_dom_sas_plus_problem_range_of:
assumes "is_valid_problem_sas_plus Ψ"
shows "∀v ∈ set ((Ψ)⇩𝒱⇩+). v ∈ dom (sas_plus_problem.range_of Ψ)"
using assms(1) is_valid_problem_sas_plus_then(1)
unfolding is_valid_problem_sas_plus_def
by (meson domIff list.pred_set)
lemma possible_assignments_for_set_is:
assumes "v ∈ dom (sas_plus_problem.range_of Ψ)"
shows "set (possible_assignments_for Ψ v)
= { (v, a) | a. a ∈ ℛ⇩+ Ψ v }"
proof -
have "sas_plus_problem.range_of Ψ v ≠ None"
using assms(1)
by auto
thus ?thesis
unfolding possible_assignments_for_def
by fastforce
qed
lemma all_possible_assignments_for_set_is:
assumes "∀v ∈ set ((Ψ)⇩𝒱⇩+). range_of Ψ v ≠ None"
shows "set (all_possible_assignments_for Ψ)
= (⋃v ∈ set ((Ψ)⇩𝒱⇩+). { (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
proof -
let ?vs = "variables_of Ψ"
have "set (all_possible_assignments_for Ψ) =
(⋃(set ` (λv. map (λ(v, a). (v, a)) (possible_assignments_for Ψ v)) ` set ?vs))"
unfolding all_possible_assignments_for_def set_concat
using set_map
by auto
also have "… = (⋃((λv. set (possible_assignments_for Ψ v)) ` set ?vs))"
using image_comp set_map
by simp
also have "… = (⋃((λv. { (v, a) | a. a ∈ ℛ⇩+ Ψ v }) ` set ?vs))"
using possible_assignments_for_set_is assms
by fastforce
finally show ?thesis
by force
qed
lemma state_to_strips_state_dom_is_i[simp]:
assumes "∀v ∈ set ((Ψ)⇩𝒱⇩+). v ∈ dom (sas_plus_problem.range_of Ψ)"
shows "set (concat
[possible_assignments_for Ψ v. v ← filter (λv. s v ≠ None) (variables_of Ψ)])
= (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
proof -
let ?vs = "variables_of Ψ"
let ?defined = "filter (λv. s v ≠ None) ?vs"
let ?l = "concat [possible_assignments_for Ψ v. v ← ?defined]"
have nb: "set ?defined = { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }"
unfolding set_filter
by force
have "set ?l = ⋃(set ` set (map (possible_assignments_for Ψ) ?defined ))"
unfolding set_concat image_Union
by blast
also have "… = ⋃(set ` (possible_assignments_for Ψ) ` set ?defined)"
unfolding set_map
by blast
also have "… = (⋃v ∈ set ?defined. set (possible_assignments_for Ψ v))"
by blast
also have "… = (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
set (possible_assignments_for Ψ v))"
using nb
by argo
finally show ?thesis
using possible_assignments_for_set_is
is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
by fastforce
qed
lemma state_to_strips_state_dom_is:
assumes "is_valid_problem_sas_plus Ψ"
shows "dom (φ⇩S Ψ s)
= (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
proof -
let ?vs = "variables_of Ψ"
let ?l = "concat [possible_assignments_for Ψ v. v ← filter (λv. s v ≠ None) ?vs]"
have nb: "∀v ∈ set ((Ψ)⇩𝒱⇩+). v ∈ dom (sas_plus_problem.range_of Ψ)"
using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
by fastforce
have "dom (φ⇩S Ψ s) = fst ` set (map (λ(v, a). ((v, a), the (s v) = a)) ?l)"
unfolding state_to_strips_state_def
SAS_Plus_STRIPS.state_to_strips_state_def
using dom_map_of_conv_image_fst[of "map (λ(v, a). ((v, a), the (s v) = a)) ?l"]
by presburger
also have "… = fst ` (λ(v, a). ((v, a), the (s v) = a)) ` set ?l"
unfolding set_map
by blast
also have "… = (λ(v, a). fst ((v, a), the (s v) = a)) ` set ?l"
unfolding image_comp[of fst "λ(v, a). ((v, a), the (s v) = a)"] comp_apply[of
fst "λ(v, a). ((v, a), the (s v) = a)"] prod.case_distrib
by blast
finally show ?thesis
unfolding state_to_strips_state_dom_is_i[OF nb]
by force
qed
corollary state_to_strips_state_dom_element_iff:
assumes "is_valid_problem_sas_plus Ψ"
shows "(v, a) ∈ dom (φ⇩S Ψ s) ⟷ v ∈ set ((Ψ)⇩𝒱⇩+)
∧ s v ≠ None
∧ a ∈ ℛ⇩+ Ψ v"
proof -
let ?vs = "variables_of Ψ"
and ?s' = "φ⇩S Ψ s"
show ?thesis
proof (rule iffI)
assume "(v, a) ∈ dom (φ⇩S Ψ s)"
then have "v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }"
and "a ∈ ℛ⇩+ Ψ v"
unfolding state_to_strips_state_dom_is[OF assms(1)]
by force+
moreover have "v ∈ set ?vs" and "s v ≠ None"
using calculation(1)
by fastforce+
ultimately show
"v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None ∧ a ∈ ℛ⇩+ Ψ v"
by force
next
assume "v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None ∧ a ∈ ℛ⇩+ Ψ v"
then have "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "s v ≠ None"
and a_in_range_of_v: "a ∈ ℛ⇩+ Ψ v"
by simp+
then have "v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }"
by force
thus "(v, a) ∈ dom (φ⇩S Ψ s)"
unfolding state_to_strips_state_dom_is[OF assms(1)]
using a_in_range_of_v
by blast
qed
qed
lemma state_to_strips_state_range_is:
assumes "is_valid_problem_sas_plus Ψ"
and "(v, a) ∈ dom (φ⇩S Ψ s)"
shows "(φ⇩S Ψ s) (v, a) = Some (the (s v) = a)"
proof -
let ?vs = "variables_of Ψ"
let ?s' = "φ⇩S Ψ s"
and ?defined = "filter (λv. s v ≠ None) ?vs"
let ?l = "concat [possible_assignments_for Ψ v. v ← ?defined]"
have v_in_set_vs: "v ∈ set ?vs"
and s_of_v_is_not_None: "s v ≠ None"
and a_in_range_of_v: "a ∈ ℛ⇩+ Ψ v"
using assms(2)
unfolding state_to_strips_state_dom_is[OF assms(1)]
by fastforce+
moreover {
have "∀v ∈ set ((Ψ)⇩𝒱⇩+). v ∈ dom (sas_plus_problem.range_of Ψ)"
using assms(1) is_valid_problem_sas_plus_then(1)
unfolding is_valid_problem_sas_plus_def
by fastforce
moreover have "(v, a) ∈ set ?l"
unfolding state_to_strips_state_dom_is_i[OF calculation(1)]
using s_of_v_is_not_None a_in_range_of_v v_in_set_vs
by fastforce
moreover have "set ?l ≠ {}"
using calculation
by fastforce
ultimately have "(φ⇩S Ψ s) (v, a) = Some (the (s v) = a)"
using map_of_from_function_graph_is_some_if[of
?l "(v, a)" "λ(v, a). the (s v) = a"]
unfolding SAS_Plus_STRIPS.state_to_strips_state_def
state_to_strips_state_def Let_def case_prod_beta'
by fastforce
}
thus ?thesis.
qed
lemma state_to_strips_state_effect_consistent:
assumes "is_valid_problem_sas_plus Ψ"
and "(v, a) ∈ dom (φ⇩S Ψ s)"
and "(v, a') ∈ dom (φ⇩S Ψ s)"
and "(φ⇩S Ψ s) (v, a) = Some True"
and "(φ⇩S Ψ s) (v, a') = Some True"
shows "(v, a) = (v, a')"
proof -
have "the (s v) = a" and "the (s v) = a'"
using state_to_strips_state_range_is[OF assms(1)] assms(2, 3, 4, 5)
by fastforce+
thus ?thesis
by argo
qed
lemma sasp_op_to_strips_set_delete_effects_is:
assumes "is_valid_operator_sas_plus Ψ op"
shows "set (strips_operator.delete_effects_of (φ⇩O Ψ op))
= (⋃(v, a) ∈ set (effect_of op). { (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
proof -
let ?D = "range_of Ψ"
and ?effect = "effect_of op"
let ?delete = "[(v, a'). (v, a) ← ?effect, a' ← filter ((≠) a) (the (?D v))]"
{
fix v a
assume "(v, a) ∈ set ?effect"
then have "(ℛ⇩+ Ψ v) = set (the (?D v))"
using assms
using is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op
by fastforce
hence "set (filter ((≠) a) (the (?D v))) = { a' ∈ ℛ⇩+ Ψ v. a' ≠ a }"
unfolding set_filter
by blast
} note nb = this
{
have "set ?delete = ⋃(set ` (λ(v, a). map (Pair v) (filter ((≠) a) (the (?D v))))
` (set ?effect))"
using set_concat
by simp
also have "… = ⋃((λ(v, a). Pair v ` set (filter ((≠) a) (the (?D v))))
` (set ?effect))"
unfolding image_comp[of set] set_map
by auto
also have "… = (⋃(v, a) ∈ set ?effect. Pair v ` { a' ∈ ℛ⇩+ Ψ v. a' ≠ a })"
using nb
by fast
finally have "set ?delete = (⋃(v, a) ∈ set ?effect.
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
by blast
}
thus ?thesis
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def Let_def
by force
qed
lemma sas_plus_problem_to_strips_problem_variable_set_is:
assumes "is_valid_problem_sas_plus Ψ"
shows "set ((φ Ψ)⇩𝒱) = (⋃v ∈ set ((Ψ)⇩𝒱⇩+). { (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
proof -
let ?Π = "φ Ψ"
and ?vs = "variables_of Ψ"
{
have "set (strips_problem.variables_of ?Π)
= set [as. v ← ?vs, as ← possible_assignments_for Ψ v]"
unfolding sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
by force
also have "… = (⋃(set ` (λv. possible_assignments_for Ψ v) ` set ?vs))"
using set_concat
by auto
also have "… = (⋃((set ∘ possible_assignments_for Ψ) ` set ?vs))"
using image_comp[of set "λv. possible_assignments_for Ψ v" "set ?vs"]
by argo
finally have "set (strips_problem.variables_of ?Π)
= (⋃v ∈ set ?vs. set (possible_assignments_for Ψ v))"
unfolding o_apply
by blast
}
moreover have "∀v ∈ set ?vs. v ∈ dom (sas_plus_problem.range_of Ψ)"
using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms
by force
ultimately show ?thesis
using possible_assignments_for_set_is
by force
qed
corollary sas_plus_problem_to_strips_problem_variable_set_element_iff:
assumes "is_valid_problem_sas_plus Ψ"
shows "(v, a) ∈ set ((φ Ψ)⇩𝒱) ⟷ v ∈ set ((Ψ)⇩𝒱⇩+) ∧ a ∈ ℛ⇩+ Ψ v"
unfolding sas_plus_problem_to_strips_problem_variable_set_is[OF assms]
by fast
lemma sasp_op_to_strips_effect_consistent:
assumes "op = φ⇩O Ψ op'"
and "op' ∈ set ((Ψ)⇩𝒪⇩+)"
and "is_valid_operator_sas_plus Ψ op'"
shows "(v, a) ∈ set (add_effects_of op) ⟶ (v, a) ∉ set (delete_effects_of op)"
and "(v, a) ∈ set (delete_effects_of op) ⟶ (v, a) ∉ set (add_effects_of op)"
proof -
have nb: "(∀(v, a) ∈ set (effect_of op'). ∀(v', a') ∈ set (effect_of op'). v ≠ v' ∨ a = a')"
using assms(3)
unfolding is_valid_operator_sas_plus_def
SAS_Plus_Representation.is_valid_operator_sas_plus_def list_all_iff ListMem_iff Let_def
by argo
{
fix v a
assume v_a_in_add_effects_of_op: "(v, a) ∈ set (add_effects_of op)"
have "(v, a) ∉ set (delete_effects_of op)"
proof (rule ccontr)
assume "¬(v, a) ∉ set (delete_effects_of op)"
moreover have "(v, a) ∈
(⋃(v, a') ∈ set (effect_of op'). { (v, a'')
| a''. a'' ∈ (ℛ⇩+ Ψ v) ∧ a'' ≠ a' })"
using calculation sasp_op_to_strips_set_delete_effects_is
assms
by blast
moreover obtain a' where "(v, a') ∈ set (effect_of op')" and "a ≠ a'"
using calculation
by blast
moreover have "(v, a') ∈ set (add_effects_of op)"
using assms(1) calculation(3)
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
Let_def
by fastforce
moreover have "(v, a) ∈ set (effect_of op')" and "(v, a') ∈ set (effect_of op')"
using assms(1) v_a_in_add_effects_of_op calculation(5)
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
Let_def
by force+
ultimately show False
using nb
by fast
qed
}
moreover {
fix v a
assume v_a_in_delete_effects_of_op: "(v, a) ∈ set (delete_effects_of op)"
have "(v, a) ∉ set (add_effects_of op)"
proof (rule ccontr)
assume "¬(v, a) ∉ set (add_effects_of op)"
moreover have "(v, a) ∈ set (add_effects_of op)"
using calculation
by blast
moreover have "(v, a) ∈
(⋃(v, a') ∈ set (effect_of op'). { (v, a'')
| a''. a'' ∈ (ℛ⇩+ Ψ v) ∧ a'' ≠ a' })"
using sasp_op_to_strips_set_delete_effects_is
nb assms(1, 3) v_a_in_delete_effects_of_op
by force
moreover obtain a' where "(v, a') ∈ set (effect_of op')" and "a ≠ a'"
using calculation
by blast
moreover have "(v, a') ∈ set (add_effects_of op)"
using assms(1) calculation(4)
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
Let_def
by fastforce
moreover have "(v, a) ∈ set (effect_of op')" and "(v, a') ∈ set (effect_of op')"
using assms(1) calculation(2, 6)
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
by force+
ultimately show False
using nb
by fast
qed
}
ultimately show "(v, a) ∈ set (add_effects_of op)
⟶ (v, a) ∉ set (delete_effects_of op)"
and "(v, a) ∈ set (delete_effects_of op)
⟶ (v, a) ∉ set (add_effects_of op)"
by blast+
qed
lemma is_valid_problem_sas_plus_then_strips_transformation_too_iii:
assumes "is_valid_problem_sas_plus Ψ"
shows "list_all (is_valid_operator_strips (φ Ψ))
(strips_problem.operators_of (φ Ψ))"
proof -
let ?Π = "φ Ψ"
let ?vs = "strips_problem.variables_of ?Π"
{
fix op
assume "op ∈ set (strips_problem.operators_of ?Π)"
then obtain op'
where op_is: "op = φ⇩O Ψ op'"
and op'_in_operators: "op' ∈ set ((Ψ)⇩𝒪⇩+)"
unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
sas_plus_problem_to_strips_problem_def
sasp_op_to_strips_def
by auto
then have is_valid_op': "is_valid_operator_sas_plus Ψ op'"
using sublocale_sas_plus_finite_domain_representation_ii(2)[OF assms]
by blast
moreover {
fix v a
assume "(v, a) ∈ set (strips_operator.precondition_of op)"
then have "(v, a) ∈ set (sas_plus_operator.precondition_of op')"
using op_is
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by force
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using is_valid_op' calculation
using is_valid_operator_sas_plus_then(1)
by fastforce
moreover have "a ∈ ℛ⇩+ Ψ v"
using is_valid_op' calculation(1)
using is_valid_operator_sas_plus_then(2)
by fast
ultimately have "(v, a) ∈ set ?vs"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
by force
}
moreover {
fix v a
assume "(v, a) ∈ set (strips_operator.add_effects_of op)"
then have "(v, a) ∈ set (effect_of op')"
using op_is
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by force
then have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then is_valid_op'
by fastforce+
hence "(v, a) ∈ set ?vs"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
by force
}
moreover {
fix v a'
assume v_a'_in_delete_effects: "(v, a') ∈ set (strips_operator.delete_effects_of op)"
moreover have "set (strips_operator.delete_effects_of op)
= (⋃(v, a) ∈ set (effect_of op').
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
using sasp_op_to_strips_set_delete_effects_is[OF is_valid_op']
op_is
by simp
ultimately obtain a
where "(v, a) ∈ set (effect_of op')"
and a'_in: "a' ∈ { a' ∈ ℛ⇩+ Ψ v. a' ≠ a }"
by blast
moreover have "is_valid_operator_sas_plus Ψ op'"
using op'_in_operators assms(1)
is_valid_problem_sas_plus_then(2)
by blast
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using is_valid_operator_sas_plus_then calculation(1, 3)
by fast
moreover have "a' ∈ ℛ⇩+ Ψ v"
using a'_in
by blast
ultimately have "(v, a') ∈ set ?vs"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
by force
}
ultimately have "set (strips_operator.precondition_of op) ⊆ set ?vs
∧ set (strips_operator.add_effects_of op) ⊆ set ?vs
∧ set (strips_operator.delete_effects_of op) ⊆ set ?vs
∧ (∀v∈set (add_effects_of op). v ∉ set (delete_effects_of op))
∧ (∀v∈set (delete_effects_of op). v ∉ set (add_effects_of op))"
using sasp_op_to_strips_effect_consistent[OF
op_is op'_in_operators is_valid_op']
by fast+
}
thus ?thesis
unfolding is_valid_operator_strips_def STRIPS_Representation.is_valid_operator_strips_def
list_all_iff ListMem_iff Let_def
by blast
qed
lemma is_valid_problem_sas_plus_then_strips_transformation_too_iv:
assumes "is_valid_problem_sas_plus Ψ"
shows "∀x. ((φ Ψ)⇩I) x ≠ None
⟷ ListMem x (strips_problem.variables_of (φ Ψ))"
proof -
let ?vs = "variables_of Ψ"
and ?I = "initial_of Ψ"
and ?Π = "φ Ψ"
let ?vs' = "strips_problem.variables_of ?Π"
and ?I' = "strips_problem.initial_of ?Π"
{
fix x
have "?I' x ≠ None ⟷ ListMem x ?vs'"
proof (rule iffI)
assume I'_of_x_is_not_None: "?I' x ≠ None"
then have "x ∈ dom ?I'"
by blast
moreover obtain v a where x_is: "x = (v, a)"
by fastforce
ultimately have "(v, a) ∈ dom ?I'"
by blast
then have "v ∈ set ?vs"
and "?I v ≠ None"
and "a ∈ ℛ⇩+ Ψ v"
using state_to_strips_state_dom_element_iff[OF assms(1), of v a ?I]
unfolding sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
state_to_strips_state_def
SAS_Plus_STRIPS.state_to_strips_state_def
by simp+
thus "ListMem x ?vs'"
unfolding ListMem_iff
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
x_is
by auto
next
assume list_mem_x_vs': "ListMem x ?vs'"
then obtain v a where x_is: "x = (v, a)"
by fastforce
then have "(v, a) ∈ set ?vs'"
using list_mem_x_vs'
unfolding ListMem_iff
by blast
then have "v ∈ set ?vs" and "a ∈ ℛ⇩+ Ψ v"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
by force+
moreover have "?I v ≠ None"
using is_valid_problem_sas_plus_then(3) assms(1) calculation(1)
by auto
ultimately have "(v, a) ∈ dom ?I'"
using state_to_strips_state_dom_element_iff[OF assms(1), of v a ?I]
unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.state_to_strips_state_def
state_to_strips_state_def
by force
thus "?I' x ≠ None"
using x_is
by fastforce
qed
}
thus ?thesis
by simp
qed
private lemma is_valid_problem_sas_plus_then_strips_transformation_too_v:
assumes "is_valid_problem_sas_plus Ψ"
shows "∀x. ((φ Ψ)⇩G) x ≠ None
⟶ ListMem x (strips_problem.variables_of (φ Ψ))"
proof -
let ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
and ?G = "goal_of Ψ"
let ?Π = "φ Ψ"
let ?vs' = "strips_problem.variables_of ?Π"
and ?G' = "strips_problem.goal_of ?Π"
have nb: "?G' = φ⇩S Ψ ?G"
by simp
{
fix x
assume "?G' x ≠ None"
moreover obtain v a where "x = (v, a)"
by fastforce
moreover have "(v, a) ∈ dom ?G'"
using domIff calculation(1, 2)
by blast
moreover have "v ∈ set ?vs" and "a ∈ ℛ⇩+ Ψ v"
using state_to_strips_state_dom_is[OF assms(1), of ?G] nb calculation(3)
by auto+
ultimately have "x ∈ set ?vs'"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
by auto
}
thus ?thesis
unfolding ListMem_iff
by simp
qed
text ‹ We now show that given \<^term>‹Ψ› is a valid SASPlus problem, then \<^term>‹Π ≡ φ Ψ› is a valid
STRIPS problem as well.
The proof unfolds the definition of \<^term>‹is_valid_problem_strips› and then shows each of the conjuncts
for \<^term>‹Π›. These are:
\begin{itemize}
\item \<^term>‹Π› has at least one variable;
\item \<^term>‹Π› has at least one operator;
\item all operators are valid STRIPS operators;
\item \<^term>‹(Π::'a strips_problem)⇩I› is defined for all variables in \<^term>‹(Π::'a strips_problem)⇩𝒱›; and finally,
\item if \<^term>‹((Π::'a strips_problem)⇩G) x› is defined, then \<^term>‹x› is in \<^term>‹(Π::'a strips_problem)⇩𝒱›.
\end{itemize} ›
theorem
is_valid_problem_sas_plus_then_strips_transformation_too:
assumes "is_valid_problem_sas_plus Ψ"
shows "is_valid_problem_strips (φ Ψ)"
proof -
let ?Π = "φ Ψ"
have "list_all (is_valid_operator_strips (φ Ψ))
(strips_problem.operators_of (φ Ψ))"
using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms].
moreover have "∀x. (((φ Ψ)⇩I) x ≠ None) =
ListMem x (strips_problem.variables_of (φ Ψ))"
using is_valid_problem_sas_plus_then_strips_transformation_too_iv[OF assms].
moreover have "∀x. ((φ Ψ)⇩G) x ≠ None ⟶
ListMem x (strips_problem.variables_of (φ Ψ))"
using is_valid_problem_sas_plus_then_strips_transformation_too_v[OF assms].
ultimately show ?thesis
using is_valid_problem_strips_def
unfolding STRIPS_Representation.is_valid_problem_strips_def
by fastforce
qed
lemma set_filter_all_possible_assignments_true_is:
assumes "is_valid_problem_sas_plus Ψ"
shows "set (filter (λ(v, a). s (v, a) = Some True)
(all_possible_assignments_for Ψ))
= (⋃v ∈ set ((Ψ)⇩𝒱⇩+). Pair v ` { a ∈ ℛ⇩+ Ψ v. s (v, a) = Some True })"
proof -
let ?vs = "sas_plus_problem.variables_of Ψ"
and ?P = "(λ(v, a). s (v, a) = Some True)"
let ?l = "filter ?P (all_possible_assignments_for Ψ)"
have "set ?l = set (concat (map (filter ?P) (map (possible_assignments_for Ψ) ?vs)))"
unfolding all_possible_assignments_for_def
filter_concat[of ?P "map (possible_assignments_for Ψ) (sas_plus_problem.variables_of Ψ)"]
by simp
also have "… = set (concat (map (λv. filter ?P (possible_assignments_for Ψ v)) ?vs))"
unfolding map_map comp_apply
by blast
also have "… = set (concat (map (λv. map (Pair v)
(filter (?P ∘ Pair v) (the (range_of Ψ v)))) ?vs))"
unfolding possible_assignments_for_def filter_map
by blast
also have "… = set (concat (map (λv. map (Pair v) (filter (λa. s (v, a) = Some True)
(the (range_of Ψ v)))) ?vs))"
unfolding comp_apply
by fast
also have "… = ⋃(set ` ((λv. map (Pair v) (filter (λa. s (v, a) = Some True)
(the (range_of Ψ v)))) ` set ?vs))"
unfolding set_concat set_map..
also have "… = (⋃v ∈ set ?vs. Pair v ` set (filter (λa. s (v, a) = Some True)
(the (range_of Ψ v))))"
unfolding image_comp[of set] comp_apply set_map..
also have "… = (⋃v ∈ set ?vs. Pair v
` { a ∈ set (the (range_of Ψ v)). s (v, a) = Some True })"
unfolding set_filter..
finally show ?thesis
using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
by auto
qed
lemma strips_state_to_state_dom_is:
assumes "is_valid_problem_sas_plus Ψ"
shows "dom (φ⇩S¯ Ψ s)
= (⋃v ∈ set ((Ψ)⇩𝒱⇩+).
{ v | a. a ∈ (ℛ⇩+ Ψ v) ∧ s (v, a) = Some True })"
proof -
let ?vs = "variables_of Ψ"
and ?s' = "φ⇩S¯ Ψ s"
and ?P = "(λ(v, a). s (v, a) = Some True)"
let ?l = "filter ?P (all_possible_assignments_for Ψ)"
{
have "fst ` set ?l = fst ` (⋃v ∈ set ?vs. Pair v
` { a ∈ ℛ⇩+ Ψ v. s (v, a) = Some True })"
unfolding set_filter_all_possible_assignments_true_is[OF assms]
by auto
also have "… = (⋃v ∈ set ?vs. fst ` Pair v
` { a ∈ ℛ⇩+ Ψ v. s (v, a) = Some True })"
by blast
also have "… = (⋃v ∈ set ?vs. (λa. fst (Pair v a)) `
{ a ∈ ℛ⇩+ Ψ v. s (v, a) = Some True })"
unfolding image_comp[of fst] comp_apply
by blast
finally have "fst ` set ?l = (⋃v ∈ set ((Ψ)⇩𝒱⇩+).
{ v | a. a ∈ (ℛ⇩+ Ψ v) ∧ s (v, a) = Some True })"
unfolding setcompr_eq_image fst_conv
by simp
}
thus ?thesis
unfolding SAS_Plus_STRIPS.strips_state_to_state_def
strips_state_to_state_def dom_map_of_conv_image_fst
by blast
qed
lemma strips_state_to_state_range_is:
assumes "is_valid_problem_sas_plus Ψ"
and "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "a ∈ ℛ⇩+ Ψ v"
and "(v, a) ∈ dom s'"
and "∀(v, a) ∈ dom s'. ∀(v, a') ∈ dom s'. s' (v, a) = Some True ∧ s' (v, a') = Some True
⟶ (v, a) = (v, a')"
shows "(φ⇩S¯ Ψ s') v = Some a ⟷ the (s' (v, a))"
proof -
let ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
and ?s = "φ⇩S¯ Ψ s'"
let ?as = "all_possible_assignments_for Ψ"
let ?l = "filter (λ(v, a). s' (v, a) = Some True) ?as"
show ?thesis
proof (rule iffI)
assume s_of_v_is_Some_a: "?s v = Some a"
{
have "(v, a) ∈ set ?l"
using s_of_v_is_Some_a
unfolding SAS_Plus_STRIPS.strips_state_to_state_def
strips_state_to_state_def
using map_of_SomeD
by fast
hence "s' (v, a) = Some True"
unfolding all_possible_assignments_for_set_is set_filter
by blast
}
thus "the (s' (v, a))"
by simp
next
assume the_of_s'_of_v_a_is: "the (s' (v, a))"
then have s'_of_v_a_is_Some_true: "s' (v, a) = Some True"
using assms(4) domIff
by force
moreover {
fix v v' a a'
assume "(v, a) ∈ set ?l" and "(v', a') ∈ set ?l"
then have "v ≠ v' ∨ a = a'"
using assms(5)
by fastforce
}
moreover {
have "∀v ∈ set ((Ψ)⇩𝒱⇩+). sas_plus_problem.range_of Ψ v ≠ None"
using is_valid_problem_sas_plus_then(1) assms(1)
range_of_not_empty
by force
moreover have "set ?l = Set.filter (λ(v, a). s' (v, a) = Some True)
(⋃v ∈ set ((Ψ)⇩𝒱⇩+). { (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
using all_possible_assignments_for_set_is calculation
by force
ultimately have "(v, a) ∈ set ?l"
using assms(2, 3) s'_of_v_a_is_Some_true
by simp
}
ultimately show "?s v = Some a"
using map_of_constant_assignments_defined_if[of ?l v a]
unfolding SAS_Plus_STRIPS.strips_state_to_state_def
strips_state_to_state_def
by blast
qed
qed
lemma strips_state_to_state_inverse_is_i:
assumes "is_valid_problem_sas_plus Ψ"
and "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "s v ≠ None"
and "a ∈ ℛ⇩+ Ψ v"
shows "(φ⇩S Ψ s) (v, a) = Some (the (s v) = a)"
proof -
let ?vs = "sas_plus_problem.variables_of Ψ"
let ?s' = "φ⇩S Ψ s"
and ?f = "λ(v, a). the (s v) = a"
and ?l = "concat (map (possible_assignments_for Ψ) (filter (λv. s v ≠ None) ?vs))"
have "(v, a) ∈ dom ?s'"
using state_to_strips_state_dom_element_iff[
OF assms(1)] assms(2, 3, 4)
by presburger
{
have "v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }"
using assms(2, 3)
by blast
moreover have "∀v ∈ set ((Ψ)⇩𝒱⇩+). v ∈ dom (sas_plus_problem.range_of Ψ)"
using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of[OF assms(1)].
moreover have "set ?l = (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
{ (v, a) |a. a ∈ ℛ⇩+ Ψ v })"
unfolding state_to_strips_state_dom_is_i[OF calculation(2)]
by blast
ultimately have "(v, a) ∈ set ?l"
using assms(4)
by blast
}
moreover have "set ?l ≠ {}"
using calculation
by force
ultimately show ?thesis
unfolding SAS_Plus_STRIPS.state_to_strips_state_def
state_to_strips_state_def
using map_of_from_function_graph_is_some_if[of ?l "(v, a)" ?f]
unfolding split_def
by fastforce
qed
corollary strips_state_to_state_inverse_is_ii:
assumes "is_valid_problem_sas_plus Ψ"
and "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "s v = Some a"
and "a ∈ ℛ⇩+ Ψ v"
and "a' ∈ ℛ⇩+ Ψ v"
and "a' ≠ a"
shows "(φ⇩S Ψ s) (v, a') = Some False"
proof -
have "s v ≠ None"
using assms(3)
by simp
moreover have "the (s v) ≠ a'"
using assms(3, 6)
by simp
ultimately show ?thesis
using strips_state_to_state_inverse_is_i[OF assms(1, 2) _ assms(5)]
by force
qed
corollary strips_state_to_state_inverse_is_iii:
assumes "is_valid_problem_sas_plus Ψ"
and "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "s v = Some a"
and "a ∈ ℛ⇩+ Ψ v"
and "a' ∈ ℛ⇩+ Ψ v"
and "(φ⇩S Ψ s) (v, a) = Some True"
and "(φ⇩S Ψ s) (v, a') = Some True"
shows "a = a'"
proof -
have "s v ≠ None"
using assms(3)
by blast
thus ?thesis
using strips_state_to_state_inverse_is_i[OF assms(1, 2)] assms(4, 5, 6, 7)
by auto
qed
lemma strips_state_to_state_inverse_is_iv:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "s v = Some a"
and "a ∈ ℛ⇩+ Ψ v"
shows "(φ⇩S¯ Ψ (φ⇩S Ψ s)) v = Some a"
proof -
let ?vs = "variables_of Ψ"
and ?s' = "φ⇩S Ψ s"
let ?s'' = "φ⇩S¯ Ψ ?s'"
let ?P = "λ(v, a). ?s' (v, a) = Some True"
let ?as = "filter ?P (all_possible_assignments_for Ψ)"
and ?As = "Set.filter ?P (⋃v ∈ set ((Ψ)⇩𝒱⇩+).
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
{
have "∀v ∈ set ((Ψ)⇩𝒱⇩+). range_of Ψ v ≠ None"
using sublocale_sas_plus_finite_domain_representation_ii(1)[OF assms(1)]
range_of_not_empty
by force
hence "set ?as = ?As"
unfolding set_filter
using all_possible_assignments_for_set_is
by force
} note nb = this
moreover {
{
fix v v' a a'
assume "(v, a) ∈ set ?as"
and "(v', a') ∈ set ?as"
then have "(v, a) ∈ ?As" and "(v', a') ∈ ?As"
using nb
by blast+
then have v_in_set_vs: "v ∈ set ?vs" and v'_in_set_vs: "v' ∈ set ?vs"
and a_in_range_of_v: "a ∈ ℛ⇩+ Ψ v"
and a'_in_range_of_v: "a' ∈ ℛ⇩+ Ψ v'"
and s'_of_v_a_is: "?s' (v, a) = Some True" and s'_of_v'_a'_is: "?s' (v', a') = Some True"
by fastforce+
then have "(v, a) ∈ dom ?s'"
by blast
then have s_of_v_is_Some_a: "s v = Some a"
using state_to_strips_state_dom_element_iff[OF assms(1)]
state_to_strips_state_range_is[OF assms(1)] s'_of_v_a_is
by auto
have "v ≠ v' ∨ a = a'"
proof (rule ccontr)
assume "¬(v ≠ v' ∨ a = a')"
then have "v = v'" and "a ≠ a'"
by simp+
thus False
using a'_in_range_of_v a_in_range_of_v assms(1) v'_in_set_vs s'_of_v'_a'_is
s'_of_v_a_is s_of_v_is_Some_a strips_state_to_state_inverse_is_iii
by force
qed
}
moreover {
have "s v ≠ None"
using assms(4)
by simp
then have "?s' (v, a) = Some True"
using strips_state_to_state_inverse_is_i[OF assms(1, 3) _ assms(5)]
assms(4)
by simp
hence "(v, a) ∈ set ?as"
using all_possible_assignments_for_set_is assms(3, 5) nb
by simp
}
ultimately have "map_of ?as v = Some a"
using map_of_constant_assignments_defined_if[of ?as v a]
by blast
}
thus ?thesis
unfolding SAS_Plus_STRIPS.strips_state_to_state_def
strips_state_to_state_def all_possible_assignments_for_def
by simp
qed
lemma strips_state_to_state_inverse_is:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom s. the (s v) ∈ ℛ⇩+ Ψ v"
shows "s = (φ⇩S¯ Ψ (φ⇩S Ψ s))"
proof -
let ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
let ?s' = "φ⇩S Ψ s"
let ?s'' = "φ⇩S¯ Ψ ?s'"
{
fix v
assume v_in_dom_s: "v ∈ dom s"
then have v_in_set_vs: "v ∈ set ?vs"
using assms(2)
by auto
then obtain a
where the_s_v_is_a: "s v = Some a"
and a_in_dom_v: "a ∈ ℛ⇩+ Ψ v"
using assms(2, 3) v_in_dom_s
by force
moreover have "?s'' v = Some a"
using strips_state_to_state_inverse_is_iv[OF assms(1, 2)] v_in_set_vs
the_s_v_is_a a_in_dom_v
by force
ultimately have "s v = ?s'' v"
by argo
} note nb = this
moreover {
fix v
assume "v ∈ dom ?s''"
then obtain a
where "a ∈ ℛ⇩+ Ψ v"
and "?s' (v, a) = Some True"
using strips_state_to_state_dom_is[OF assms(1)]
by blast
then have "(v, a) ∈ dom ?s'"
by blast
then have "s v ≠ None"
using state_to_strips_state_dom_is[OF assms(1)]
by simp
then obtain a where "s v = Some a"
by blast
hence "?s'' v = s v"
using nb
by fastforce
}
ultimately show ?thesis
using map_le_antisym[of s ?s''] map_le_def
unfolding strips_state_to_state_def
state_to_strips_state_def
by blast
qed
lemma state_to_strips_state_map_le_iff:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom s. the (s v) ∈ ℛ⇩+ Ψ v"
shows "s ⊆⇩m t ⟷ (φ⇩S Ψ s) ⊆⇩m (φ⇩S Ψ t)"
proof -
let ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
and ?s' = "φ⇩S Ψ s"
and ?t' = "φ⇩S Ψ t"
show ?thesis
proof (rule iffI)
assume s_map_le_t: "s ⊆⇩m t"
{
fix v a
assume "(v, a) ∈ dom ?s'"
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "s v ≠ None" and "a ∈ ℛ⇩+ Ψ v"
using state_to_strips_state_dom_is[OF assms(1)] calculation
by blast+
moreover have "?s' (v, a) = Some (the (s v) = a)"
using state_to_strips_state_range_is[OF assms(1)] calculation(1)
by meson
moreover have "v ∈ dom s"
using calculation(3)
by auto
moreover have "s v = t v"
using s_map_le_t calculation(6)
unfolding map_le_def
by blast
moreover have "t v ≠ None"
using calculation(3, 7)
by argo
moreover have "(v, a) ∈ dom ?t'"
using state_to_strips_state_dom_is[OF assms(1)] calculation(2, 4, 8)
by blast
moreover have "?t' (v, a) = Some (the (t v) = a)"
using state_to_strips_state_range_is[OF assms(1)] calculation(9)
by simp
ultimately have "?s' (v, a) = ?t' (v, a)"
by presburger
}
thus "?s' ⊆⇩m ?t'"
unfolding map_le_def
by fast
next
assume s'_map_le_t': "?s' ⊆⇩m ?t'"
{
fix v
assume v_in_dom_s: "v ∈ dom s"
moreover obtain a where the_of_s_of_v_is_a: "the (s v) = a"
by blast
moreover have v_in_vs: "v ∈ set ((Ψ)⇩𝒱⇩+)"
and s_of_v_is_not_None: "s v ≠ None"
and a_in_range_of_v: "a ∈ ℛ⇩+ Ψ v"
using assms(2, 3) v_in_dom_s calculation
by blast+
moreover have "(v, a) ∈ dom ?s'"
using state_to_strips_state_dom_is[OF assms(1)]
calculation(3, 4, 5)
by simp
moreover have "?s' (v, a) = ?t' (v, a)"
using s'_map_le_t' calculation
unfolding map_le_def
by blast
moreover have "(v, a) ∈ dom ?t'"
using calculation
unfolding domIff
by argo
moreover have "?s' (v, a) = Some (the (s v) = a)"
and "?t' (v, a) = Some (the (t v) = a)"
using state_to_strips_state_range_is[OF assms(1)] calculation
by fast+
moreover have "s v = Some a"
using calculation(2, 4)
by force
moreover have "?s' (v, a) = Some True"
using calculation(9, 11)
by fastforce
moreover have "?t' (v, a) = Some True"
using calculation(7, 12)
by argo
moreover have "the (t v) = a"
using calculation(10, 13) try0
by force
moreover {
have "v ∈ dom t"
using state_to_strips_state_dom_element_iff[OF assms(1)]
calculation(8)
by auto
hence "t v = Some a"
using calculation(14)
by force
}
ultimately have "s v = t v"
by argo
}
thus "s ⊆⇩m t"
unfolding map_le_def
by simp
qed
qed
lemma sas_plus_operator_inverse_is:
assumes "is_valid_problem_sas_plus Ψ"
and "op ∈ set ((Ψ)⇩𝒪⇩+)"
shows "(φ⇩O¯ Ψ (φ⇩O Ψ op)) = op"
proof -
let ?op = "φ⇩O¯ Ψ (φ⇩O Ψ op)"
have "precondition_of ?op = precondition_of op"
unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by fastforce
moreover have "effect_of ?op = effect_of op"
unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by force
ultimately show ?thesis
by simp
qed
lemma strips_operator_inverse_is:
assumes "is_valid_problem_sas_plus Ψ"
and "op' ∈ set ((φ Ψ)⇩𝒪)"
shows "(φ⇩O Ψ (φ⇩O¯ Ψ op')) = op'"
proof -
let ?Π = "φ Ψ"
obtain op where "op ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op"
using assms
by auto
moreover have "φ⇩O¯ Ψ op' = op"
using sas_plus_operator_inverse_is[OF assms(1) calculation(1)] calculation(2)
by blast
ultimately show ?thesis
by argo
qed
lemma sas_plus_equivalent_to_strips_i_a_I:
assumes "is_valid_problem_sas_plus Ψ"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ s) ops'"
and "op ∈ set [φ⇩O¯ Ψ op'. op' ← ops']"
shows "map_of (precondition_of op) ⊆⇩m (φ⇩S¯ Ψ (φ⇩S Ψ s))"
proof -
let ?Π = "φ Ψ"
and ?s' = "φ⇩S Ψ s"
let ?s = "φ⇩S¯ Ψ ?s'"
and ?D = "range_of Ψ"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
and ?pre = "precondition_of op"
have nb⇩1: "∀(v, a) ∈ dom ?s'.
∀(v, a') ∈ dom ?s'.
?s' (v, a) = Some True ∧ ?s' (v, a') = Some True
⟶ (v, a) = (v, a')"
using state_to_strips_state_effect_consistent[OF assms(1)]
by blast
{
fix op'
assume "op' ∈ set ops'"
moreover have "op' ∈ set ((?Π)⇩𝒪)"
using assms(2) calculation
by blast
ultimately have "∃op ∈ set ((Ψ)⇩𝒪⇩+). op' = (φ⇩O Ψ op)"
by auto
} note nb⇩2 = this
{
fix op
assume "op ∈ set ?ops"
then obtain op' where "op' ∈ set ops'" and "op = φ⇩O¯ Ψ op'"
using assms(4)
by auto
moreover obtain op'' where "op'' ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op''"
using nb⇩2 calculation(1)
by blast
moreover have "op = op''"
using sas_plus_operator_inverse_is[OF assms(1) calculation(3)] calculation(2, 4)
by blast
ultimately have "op ∈ set ((Ψ)⇩𝒪⇩+)"
by blast
} note nb⇩3 = this
{
fix op v a
assume "op ∈ set ?ops"
and v_a_in_precondition_of_op': "(v, a) ∈ set (precondition_of op)"
moreover obtain op' where "op' ∈ set ops'" and "op = φ⇩O¯ Ψ op'"
using calculation(1)
by auto
moreover have "strips_operator.precondition_of op' = precondition_of op"
using calculation(4)
unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by simp
ultimately have "∃op' ∈ set ops'. op = (φ⇩O¯ Ψ op')
∧ (v, a) ∈ set (strips_operator.precondition_of op')"
by metis
} note nb⇩4 = this
{
fix op' v a
assume "op' ∈ set ops'"
and v_a_in_precondition_of_op': "(v, a) ∈ set (strips_operator.precondition_of op')"
moreover have s'_of_v_a_is_Some_True: "?s' (v, a) = Some True"
using assms(3) calculation(1, 2)
unfolding are_all_operators_applicable_set
by blast
moreover {
obtain op where "op ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op"
using nb⇩2 calculation(1)
by blast
moreover have "strips_operator.precondition_of op' = precondition_of op"
using calculation(2)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by simp
moreover have "(v, a) ∈ set (precondition_of op)"
using v_a_in_precondition_of_op' calculation(3)
by argo
moreover have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
unfolding is_valid_operator_sas_plus_def
by auto
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(1,2) calculation(4, 5)
unfolding is_valid_operator_sas_plus_def
by fastforce+
moreover have "v ∈ dom ?s"
using strips_state_to_state_dom_is[OF assms(1), of ?s']
s'_of_v_a_is_Some_True calculation(6, 7)
by blast
moreover have "(v, a) ∈ dom ?s'"
using s'_of_v_a_is_Some_True domIff
by blast
ultimately have "?s v = Some a"
using strips_state_to_state_range_is[OF assms(1) _ _ _ nb⇩1]
s'_of_v_a_is_Some_True
by simp
}
hence "?s v = Some a".
} note nb⇩5 = this
{
fix v
assume "v ∈ dom (map_of ?pre)"
then obtain a where "map_of ?pre v = Some a"
by fast
moreover have "(v, a) ∈ set ?pre"
using map_of_SomeD calculation
by fast
moreover {
have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(4) nb⇩3
by blast
then have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1)
unfolding is_valid_operator_sas_plus_def
by auto
hence "∀(v, a) ∈ set ?pre. ∀(v', a') ∈ set ?pre. v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then(5)
unfolding is_valid_operator_sas_plus_def
by fast
}
moreover have "map_of ?pre v = Some a"
using map_of_constant_assignments_defined_if[of ?pre] calculation(2, 3)
by blast
moreover obtain op' where "op' ∈ set ops'"
and "(v, a) ∈ set (strips_operator.precondition_of op')"
using nb⇩4[OF assms(4) calculation(2)]
by blast
moreover have "?s v = Some a"
using nb⇩5 calculation(5, 6)
by fast
ultimately have "map_of ?pre v = ?s v"
by argo
}
thus ?thesis
unfolding map_le_def
by blast
qed
lemma to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure:
assumes "is_valid_problem_sas_plus Ψ"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "op ∈ set [φ⇩O¯ Ψ op'. op' ← ops']"
shows "op ∈ set ((Ψ)⇩𝒪⇩+) ∧ (∃op' ∈ set ops'. op' = φ⇩O Ψ op)"
proof -
let ?Π = "φ Ψ"
obtain op' where "op' ∈ set ops'" and "op = φ⇩O¯ Ψ op'"
using assms(3)
by auto
moreover have "op' ∈ set ((?Π)⇩𝒪)"
using assms(2) calculation(1)
by blast
moreover obtain op'' where "op'' ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op''"
using calculation(3)
by auto
moreover have "op = op''"
using sas_plus_operator_inverse_is[OF assms(1) calculation(4)] calculation(2, 5)
by presburger
ultimately show ?thesis
by blast
qed
lemma sas_plus_equivalent_to_strips_i_a_II:
fixes Ψ :: "('variable, 'domain) sas_plus_problem"
fixes s :: "('variable, 'domain) state"
assumes "is_valid_problem_sas_plus Ψ"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "STRIPS_Semantics.are_all_operators_applicable (φ⇩s Ψ s) ops'
∧ STRIPS_Semantics.are_all_operator_effects_consistent ops'"
shows "are_all_operator_effects_consistent [φ⇩O¯ Ψ op'. op' ← ops']"
proof -
let ?s' = "φ⇩S Ψ s"
let ?s = "φ⇩S¯ Ψ ?s'"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
and ?Π = "φ Ψ"
have nb: "∀(v, a) ∈ dom ?s'.
∀(v, a') ∈ dom ?s'.
?s' (v, a) = Some True ∧ ?s' (v, a') = Some True
⟶ (v, a) = (v, a')"
using state_to_strips_state_effect_consistent[OF assms(1)]
by blast
{
fix op⇩1' op⇩2'
assume "op⇩1' ∈ set ops'" and "op⇩2' ∈ set ops'"
hence "STRIPS_Semantics.are_operator_effects_consistent op⇩1' op⇩2'"
using assms(3)
unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
by blast
} note nb⇩1 = this
{
fix op⇩1 op⇩1' op⇩2 op⇩2'
assume op⇩1_in_ops: "op⇩1 ∈ set ?ops"
and op⇩1'_in_ops': "op⇩1' ∈ set ops'"
and op⇩1'_is: "op⇩1' = φ⇩O Ψ op⇩1"
and is_valid_op⇩1: "is_valid_operator_sas_plus Ψ op⇩1"
and op⇩2_in_ops: "op⇩2 ∈ set ?ops"
and op⇩2'_in_ops': "op⇩2' ∈ set ops'"
and op⇩2'_is: "op⇩2' = φ⇩O Ψ op⇩2"
and is_valid_op⇩2: "is_valid_operator_sas_plus Ψ op⇩2"
have "∀(v, a) ∈ set (add_effects_of op⇩1'). ∀(v', a') ∈ set (add_effects_of op⇩2').
v ≠ v' ∨ a = a'"
proof (rule ccontr)
assume "¬(∀(v, a) ∈ set (add_effects_of op⇩1'). ∀(v', a') ∈ set (add_effects_of op⇩2').
v ≠ v' ∨ a = a')"
then obtain v v' a a' where "(v, a) ∈ set (add_effects_of op⇩1')"
and "(v', a') ∈ set (add_effects_of op⇩2')"
and "v = v'"
and "a ≠ a'"
by blast
moreover have "(v, a) ∈ set (effect_of op⇩1)"
using op⇩1'_is op⇩2'_is calculation(1, 2)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by force
moreover {
have "(v', a') ∈ set (effect_of op⇩2)"
using op⇩2'_is calculation(2)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by force
hence "a' ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then is_valid_op⇩2 calculation(3)
by fastforce
}
moreover have "(v, a') ∈ set (delete_effects_of op⇩1')"
using sasp_op_to_strips_set_delete_effects_is
op⇩1'_is is_valid_op⇩1 calculation(3, 4, 5, 6)
by blast
moreover have "¬STRIPS_Semantics.are_operator_effects_consistent op⇩1' op⇩2'"
unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff
using calculation(2, 3, 7)
by meson
ultimately show False
using assms(3) op⇩1'_in_ops' op⇩2'_in_ops'
unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
by blast
qed
} note nb⇩3 = this
{
fix op⇩1 op⇩2
assume op⇩1_in_ops: "op⇩1 ∈ set ?ops" and op⇩2_in_ops: "op⇩2 ∈ set ?ops"
moreover have op⇩1_in_operators_of_Ψ: "op⇩1 ∈ set ((Ψ)⇩𝒪⇩+)"
and op⇩2_in_operators_of_Ψ: "op⇩2 ∈ set ((Ψ)⇩𝒪⇩+)"
using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF
assms(1, 2)] calculation
by blast+
moreover have is_valid_operator_op⇩1: "is_valid_operator_sas_plus Ψ op⇩1"
and is_valid_operator_op⇩2: "is_valid_operator_sas_plus Ψ op⇩2"
using is_valid_problem_sas_plus_then(2) op⇩1_in_operators_of_Ψ op⇩2_in_operators_of_Ψ
assms(1)
unfolding is_valid_operator_sas_plus_def
by auto+
moreover obtain op⇩1' op⇩2'
where op⇩1_in_ops': "op⇩1' ∈ set ops'"
and op⇩1_is: "op⇩1' = φ⇩O Ψ op⇩1"
and op⇩2_in_ops': "op⇩2' ∈ set ops'"
and op⇩2_is: "op⇩2' = φ⇩O Ψ op⇩2"
using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF
assms(1, 2)] op⇩1_in_ops op⇩2_in_ops
by blast
ultimately have "∀(v, a) ∈ set (add_effects_of op⇩1'). ∀(v', a') ∈ set (add_effects_of op⇩2').
v ≠ v' ∨ a = a'"
using nb⇩3
by auto
hence "are_operator_effects_consistent op⇩1 op⇩2"
using op⇩1_is op⇩2_is
unfolding are_operator_effects_consistent_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
list_all_iff Let_def
by simp
}
thus ?thesis
unfolding are_all_operator_effects_consistent_def list_all_iff
by fast
qed
lemma sas_plus_equivalent_to_strips_i_a_IV:
assumes "is_valid_problem_sas_plus Ψ"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ s) ops'
∧ STRIPS_Semantics.are_all_operator_effects_consistent ops'"
shows "are_all_operators_applicable_in (φ⇩S¯ Ψ (φ⇩S Ψ s)) [φ⇩O¯ Ψ op'. op' ← ops'] ∧
are_all_operator_effects_consistent [φ⇩O¯ Ψ op'. op' ← ops']"
proof -
let ?Π = "φ Ψ"
and ?s' = "φ⇩S Ψ s"
let ?vs' = "strips_problem.variables_of ?Π"
and ?ops' = "strips_problem.operators_of ?Π"
and ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
and ?s = "φ⇩S¯ Ψ ?s'"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
have nb: "∀(v, a) ∈ dom ?s'.
∀(v, a') ∈ dom (φ⇩S Ψ s).
?s' (v, a) = Some True ∧ ?s' (v, a') = Some True
⟶ (v, a) = (v, a')"
using state_to_strips_state_effect_consistent[OF assms(1)]
by blast
{
have "STRIPS_Semantics.are_all_operators_applicable ?s' ops'"
using assms(3)
by simp
moreover have "list_all (λop. map_of (precondition_of op) ⊆⇩m ?s) ?ops"
using sas_plus_equivalent_to_strips_i_a_I[OF assms(1) assms(2)] calculation
unfolding list_all_iff
by blast
moreover have "list_all (λop. list_all (are_operator_effects_consistent op) ?ops) ?ops"
using sas_plus_equivalent_to_strips_i_a_II assms nb
unfolding are_all_operator_effects_consistent_def is_valid_operator_sas_plus_def list_all_iff
by blast
ultimately have "are_all_operators_applicable_in ?s ?ops"
unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def list_all_iff
by argo
}
moreover have "are_all_operator_effects_consistent ?ops"
using sas_plus_equivalent_to_strips_i_a_II assms nb
by simp
ultimately show ?thesis
by simp
qed
lemma sas_plus_equivalent_to_strips_i_a_VI:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom s. the (s v) ∈ ℛ⇩+ Ψ v"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "are_all_operators_applicable_in s [φ⇩O¯ Ψ op'. op' ← ops'] ∧
are_all_operator_effects_consistent [φ⇩O¯ Ψ op'. op' ← ops']"
shows "STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ s) ops'"
proof -
let ?vs = "variables_of Ψ"
and ?D = "range_of Ψ"
and ?Π = "φ Ψ"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
and ?s' = "φ⇩S Ψ s"
{
fix op'
assume "op' ∈ set ops'"
moreover obtain op where "op ∈ set ?ops" and "op = φ⇩O¯ Ψ op'"
using calculation
by force
moreover obtain op'' where "op'' ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op''"
using assms(4) calculation(1)
by auto
moreover have "is_valid_operator_sas_plus Ψ op''"
using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
unfolding is_valid_operator_sas_plus_def
by auto
moreover have "op = op''"
using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
by blast
ultimately have "∃op ∈ set ?ops. op ∈ set ?ops ∧ op = (φ⇩O¯ Ψ op')
∧ is_valid_operator_sas_plus Ψ op"
by blast
} note nb⇩1 = this
have nb⇩2: "∀(v, a) ∈ dom ?s'.
∀(v, a') ∈ dom ?s'.
?s' (v, a) = Some True ∧ ?s' (v, a') = Some True
⟶ (v, a) = (v, a')"
using state_to_strips_state_effect_consistent[OF assms(1), of _ _ s]
by blast
{
fix op
assume "op ∈ set ?ops"
hence "map_of (precondition_of op) ⊆⇩m s"
using assms(5)
unfolding are_all_operators_applicable_in_def
is_operator_applicable_in_def list_all_iff
by blast
} note nb⇩3 = this
{
fix op'
assume "op' ∈ set ops'"
then obtain op where op_in_ops: "op ∈ set ?ops"
and op_is: "op = (φ⇩O¯ Ψ op')"
and is_valid_operator_op: "is_valid_operator_sas_plus Ψ op"
using nb⇩1
by force
moreover have preconditions_are_consistent:
"∀(v, a) ∈ set (precondition_of op). ∀(v', a') ∈ set (precondition_of op). v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then(5) calculation(3)
unfolding is_valid_operator_sas_plus_def
by fast
moreover {
fix v a
assume "(v, a) ∈ set (strips_operator.precondition_of op')"
moreover have v_a_in_precondition_of_op: "(v, a) ∈ set (precondition_of op)"
using op_is calculation
unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by auto
moreover have "map_of (precondition_of op) v = Some a"
using map_of_constant_assignments_defined_if[OF
preconditions_are_consistent calculation(2)]
by blast
moreover have s_of_v_is: "s v = Some a"
using nb⇩3[OF op_in_ops] calculation(3)
unfolding map_le_def
by force
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(1, 2) is_valid_operator_op
v_a_in_precondition_of_op
unfolding is_valid_operator_sas_plus_def
SAS_Plus_Representation.is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
by auto+
moreover have "(v, a) ∈ dom ?s'"
using state_to_strips_state_dom_is[OF assms(1)] s_of_v_is
calculation
by simp
moreover have "(φ⇩S¯ Ψ ?s') v = Some a"
using strips_state_to_state_inverse_is[OF assms(1, 2, 3)] s_of_v_is
by argo
ultimately have "?s' (v, a) = Some True"
using strips_state_to_state_range_is[OF assms(1)] nb⇩2
by auto
}
ultimately have "∀(v, a) ∈ set (strips_operator.precondition_of op'). ?s' (v, a) = Some True"
by fast
}
thus ?thesis
unfolding are_all_operators_applicable_def is_operator_applicable_in_def
STRIPS_Representation.is_operator_applicable_in_def list_all_iff
by simp
qed
lemma sas_plus_equivalent_to_strips_i_a_VII:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom s. the (s v) ∈ ℛ⇩+ Ψ v"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "are_all_operators_applicable_in s [φ⇩O¯ Ψ op'. op' ← ops'] ∧
are_all_operator_effects_consistent [φ⇩O¯ Ψ op'. op' ← ops']"
shows "STRIPS_Semantics.are_all_operator_effects_consistent ops'"
proof -
let ?s' = "φ⇩S Ψ s"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
and ?D = "range_of Ψ"
and ?Π = "φ Ψ"
{
fix op'
assume "op' ∈ set ops'"
moreover obtain op where "op ∈ set ?ops" and "op = φ⇩O¯ Ψ op'"
using calculation
by force
moreover obtain op'' where "op'' ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op''"
using assms(4) calculation(1)
by auto
moreover have "is_valid_operator_sas_plus Ψ op''"
using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
unfolding is_valid_operator_sas_plus_def
by auto
moreover have "op = op''"
using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
by blast
ultimately have "∃op ∈ set ?ops. op ∈ set ?ops ∧ op' = (φ⇩O Ψ op)
∧ is_valid_operator_sas_plus Ψ op"
by blast
} note nb⇩1 = this
{
fix op⇩1' op⇩2'
assume "op⇩1' ∈ set ops'"
and "op⇩2' ∈ set ops'"
and "∃(v, a) ∈ set (add_effects_of op⇩1'). ∃(v', a') ∈ set (delete_effects_of op⇩2').
(v, a) = (v', a')"
moreover obtain op⇩1 op⇩2
where "op⇩1 ∈ set ?ops"
and "op⇩1' = φ⇩O Ψ op⇩1"
and "is_valid_operator_sas_plus Ψ op⇩1"
and "op⇩2 ∈ set ?ops"
and "op⇩2' = φ⇩O Ψ op⇩2"
and is_valid_op⇩2: "is_valid_operator_sas_plus Ψ op⇩2"
using nb⇩1 calculation(1, 2)
by meson
moreover obtain v v' a a'
where "(v, a) ∈ set (add_effects_of op⇩1')"
and "(v', a') ∈ set (delete_effects_of op⇩2')"
and "(v, a) = (v', a')"
using calculation
by blast
moreover have "(v, a) ∈ set (effect_of op⇩1)"
using calculation(5, 10)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by fastforce
moreover have "v = v'" and "a = a'"
using calculation(12)
by simp+
moreover {
have "(v', a') ∈ (⋃(v'', a'') ∈ set (effect_of op⇩2).
{ (v'', a''') | a'''. a''' ∈ (ℛ⇩+ Ψ v'') ∧ a''' ≠ a'' })"
using sasp_op_to_strips_set_delete_effects_is
calculation(8, 11) is_valid_op⇩2
by blast
then obtain v'' a'' where "(v'', a'') ∈ set (effect_of op⇩2)"
and "(v', a') ∈ { (v'', a''') | a'''. a''' ∈ (ℛ⇩+ Ψ v'') ∧ a''' ≠ a'' }"
by blast
moreover have "(v', a'') ∈ set (effect_of op⇩2)"
using calculation
by blast
moreover have "a' ∈ ℛ⇩+ Ψ v''" and "a' ≠ a''"
using calculation(1, 2)
by fast+
ultimately have "∃a''. (v', a'') ∈ set (effect_of op⇩2) ∧ a' ∈ (ℛ⇩+ Ψ v')
∧ a' ≠ a''"
by blast
}
moreover obtain a'' where "(v', a'') ∈ set (effect_of op⇩2)"
and "a' ∈ ℛ⇩+ Ψ v'"
and "a' ≠ a''"
using calculation(16)
by blast
moreover have "∃(v, a) ∈ set (effect_of op⇩1). (∃(v', a') ∈ set (effect_of op⇩2).
v = v' ∧ a ≠ a')"
using calculation(13, 14, 15, 17, 19)
by blast
moreover have "¬are_operator_effects_consistent op⇩1 op⇩2"
unfolding are_operator_effects_consistent_def list_all_iff
using calculation(20)
by fastforce
ultimately have "¬are_all_operator_effects_consistent ?ops"
unfolding are_all_operator_effects_consistent_def list_all_iff
by meson
} note nb⇩2 = this
{
fix op⇩1' op⇩2'
assume op⇩1'_in_ops: "op⇩1' ∈ set ops'" and op⇩2'_in_ops: "op⇩2' ∈ set ops'"
have "STRIPS_Semantics.are_operator_effects_consistent op⇩1' op⇩2'"
proof (rule ccontr)
assume "¬STRIPS_Semantics.are_operator_effects_consistent op⇩1' op⇩2'"
then consider (A) "∃(v, a) ∈ set (add_effects_of op⇩1').
∃(v', a') ∈ set (delete_effects_of op⇩2'). (v, a) = (v', a')"
| (B) "∃(v, a) ∈ set (add_effects_of op⇩2').
∃(v', a') ∈ set (delete_effects_of op⇩1'). (v, a) = (v', a')"
unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff
by fastforce
thus False
using nb⇩2[OF op⇩1'_in_ops op⇩2'_in_ops] nb⇩2[OF op⇩2'_in_ops op⇩1'_in_ops] assms(5)
by (cases, argo, force)
qed
}
thus ?thesis
unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def
STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff
by blast
qed
lemma sas_plus_equivalent_to_strips_i_a_VIII:
assumes "is_valid_problem_sas_plus Ψ"
and "dom s ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom s. the (s v) ∈ ℛ⇩+ Ψ v"
and "set ops' ⊆ set ((φ Ψ)⇩𝒪)"
and "are_all_operators_applicable_in s [φ⇩O¯ Ψ op'. op' ← ops'] ∧
are_all_operator_effects_consistent [φ⇩O¯ Ψ op'. op' ← ops']"
shows "STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ s) ops'
∧ STRIPS_Semantics.are_all_operator_effects_consistent ops'"
using sas_plus_equivalent_to_strips_i_a_VI sas_plus_equivalent_to_strips_i_a_VII assms
by fastforce
lemma sas_plus_equivalent_to_strips_i_a_IX:
assumes "dom s ⊆ V"
and "∀op ∈ set ops. ∀(v, a) ∈ set (effect_of op). v ∈ V"
shows "dom (execute_parallel_operator_sas_plus s ops) ⊆ V"
proof -
show ?thesis
using assms
proof (induction ops arbitrary: s)
case Nil
then show ?case
unfolding execute_parallel_operator_sas_plus_def
by simp
next
case (Cons op ops)
let ?s' = "s ++ map_of (effect_of op)"
{
have "∀(v, a) ∈ set (effect_of op). v ∈ V"
using Cons.prems(2)
by fastforce
moreover have "fst ` set (effect_of op) ⊆ V"
using calculation
by fastforce
ultimately have "dom ?s' ⊆ V"
unfolding dom_map_add dom_map_of_conv_image_fst
using Cons.prems(1)
by blast
}
moreover have "∀op ∈ set ops. ∀(v, a) ∈ set (effect_of op). v ∈ V"
using Cons.prems(2)
by fastforce
ultimately have "dom (execute_parallel_operator_sas_plus ?s' ops) ⊆ V"
using Cons.IH[of ?s']
by fast
thus ?case
unfolding execute_parallel_operator_sas_plus_cons.
qed
qed
lemma sas_plus_equivalent_to_strips_i_a_X:
assumes "dom s ⊆ V"
and "V ⊆ dom D"
and "∀v ∈ dom s. the (s v) ∈ set (the (D v))"
and "∀op ∈ set ops. ∀(v, a) ∈ set (effect_of op). v ∈ V ∧ a ∈ set (the (D v))"
shows "∀v ∈ dom (execute_parallel_operator_sas_plus s ops).
the (execute_parallel_operator_sas_plus s ops v) ∈ set (the (D v))"
proof -
show ?thesis
using assms
proof (induction ops arbitrary: s)
case Nil
then show ?case
unfolding execute_parallel_operator_sas_plus_def
by simp
next
case (Cons op ops)
let ?s' = "s ++ map_of (effect_of op)"
{
{
have "∀(v, a) ∈ set (effect_of op). v ∈ V"
using Cons.prems(4)
by fastforce
moreover have "fst ` set (effect_of op) ⊆ V"
using calculation
by fastforce
ultimately have "dom ?s' ⊆ V"
unfolding dom_map_add dom_map_of_conv_image_fst
using Cons.prems(1)
by blast
}
moreover {
fix v
assume v_in_dom_s': "v ∈ dom ?s'"
hence "the (?s' v) ∈ set (the (D v))"
proof (cases "v ∈ dom (map_of (effect_of op))")
case True
moreover have "?s' v = (map_of (effect_of op)) v"
unfolding map_add_dom_app_simps(1)[OF True]
by blast
moreover obtain a where "(map_of (effect_of op)) v = Some a"
using calculation(1)
by fast
moreover have "(v, a) ∈ set (effect_of op)"
using map_of_SomeD calculation(3)
by fast
moreover have "a ∈ set (the (D v))"
using Cons.prems(4) calculation(4)
by fastforce
ultimately show ?thesis
by force
next
case False
then show ?thesis
unfolding map_add_dom_app_simps(3)[OF False]
using Cons.prems(3) v_in_dom_s'
by fast
qed
}
moreover have "∀op ∈ set ops. ∀(v, a) ∈ set (effect_of op). v ∈ V ∧ a ∈ set (the (D v))"
using Cons.prems(4)
by auto
ultimately have "∀v ∈ dom (execute_parallel_operator_sas_plus ?s' ops).
the (execute_parallel_operator_sas_plus ?s' ops v) ∈ set (the (D v))"
using Cons.IH[of "s ++ map_of (effect_of op)", OF _ Cons.prems(2)]
by meson
}
thus ?case
unfolding execute_parallel_operator_sas_plus_cons
by blast
qed
qed
lemma transfom_sas_plus_problem_to_strips_problem_operators_valid:
assumes "is_valid_problem_sas_plus Ψ"
and "op' ∈ set ((φ Ψ)⇩𝒪)"
obtains op
where "op ∈ set ((Ψ)⇩𝒪⇩+)"
and "op' = (φ⇩O Ψ op)" "is_valid_operator_sas_plus Ψ op"
proof -
{
obtain op where "op ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op"
using assms
by auto
moreover have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
by auto
ultimately have "∃op ∈ set ((Ψ)⇩𝒪⇩+). op' = (φ⇩O Ψ op)
∧ is_valid_operator_sas_plus Ψ op"
by blast
}
thus ?thesis
using that
by blast
qed
lemma sas_plus_equivalent_to_strips_i_a_XI:
assumes "is_valid_problem_sas_plus Ψ"
and "op' ∈ set ((φ Ψ)⇩𝒪)"
shows "(φ⇩S Ψ s) ++ map_of (effect_to_assignments op')
= φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op')))"
proof -
let ?Π = "φ Ψ"
let ?vs = "variables_of Ψ"
and?ops = "operators_of Ψ"
and ?ops' = "strips_problem.operators_of ?Π"
let ?s' = "φ⇩S Ψ s"
let ?t = "?s' ++ map_of (effect_to_assignments op')"
and ?t' = "φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op')))"
obtain op where op'_is: "op' = (φ⇩O Ψ op)"
and op_in_ops: "op ∈ set ((Ψ)⇩𝒪⇩+)"
and is_valid_operator_op: "is_valid_operator_sas_plus Ψ op"
using transfom_sas_plus_problem_to_strips_problem_operators_valid[OF assms]
by auto
have nb⇩1: "(φ⇩O¯ Ψ op') = op"
using sas_plus_operator_inverse_is[OF assms(1)] op'_is op_in_ops
by blast
{
have "dom (map_of (effect_to_assignments op'))
= set (strips_operator.add_effects_of op') ∪ set (strips_operator.delete_effects_of op')"
unfolding dom_map_of_conv_image_fst
by force
also have "… = set (effect_of op) ∪ set (strips_operator.delete_effects_of op')"
using op'_is
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by auto
finally have "dom (map_of (effect_to_assignments op')) = set (effect_of op)
∪ (⋃(v, a) ∈ set (effect_of op). { (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
using sasp_op_to_strips_set_delete_effects_is[OF
is_valid_operator_op] op'_is
by argo
} note nb⇩2 = this
have nb⇩3: "dom ?t = dom ?s' ∪ set (effect_of op)
∪ (⋃(v, a) ∈ set (effect_of op). { (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
unfolding nb⇩2 dom_map_add
by blast
have nb⇩4: "dom (s ++ map_of (effect_of (φ⇩O¯ Ψ op')))
= dom s ∪ fst ` set (effect_of op)"
unfolding dom_map_add dom_map_of_conv_image_fst nb⇩1
by fast
{
let ?u = "s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"
have "dom ?t' = (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ ?u v ≠ None }.
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
using state_to_strips_state_dom_is[OF assms(1)]
by presburger
} note nb⇩5 = this
have nb⇩6: "set (add_effects_of op') = set (effect_of op)"
using op'_is
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def
by auto
have nb⇩7: "set (delete_effects_of op') = (⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
using sasp_op_to_strips_set_delete_effects_is[OF
is_valid_operator_op] op'_is
by argo
{
let ?Add = "set (effect_of op)"
let ?Delete = "(⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
have dom_add: "dom (map_of (map (λv. (v, True)) (add_effects_of op'))) = ?Add"
unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply
using nb⇩6
by simp
have dom_delete: "dom (map_of (map (λv. (v, False)) (delete_effects_of op'))) = ?Delete"
unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply
using nb⇩7
by auto
{
{
fix v a
assume v_a_in_dom_add: "(v, a) ∈ dom (map_of (map (λv. (v, True)) (add_effects_of op')))"
have "(v, a) ∉ dom (map_of (map (λv. (v, False)) (delete_effects_of op')))"
proof (rule ccontr)
assume "¬((v, a) ∉ dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))"
then have "(v, a) ∈ ?Delete" and "(v, a) ∈ ?Add"
using dom_add dom_delete v_a_in_dom_add
by argo+
moreover have "∀(v', a') ∈ ?Add. v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then(6) is_valid_operator_op
calculation(2)
unfolding is_valid_operator_sas_plus_def
by fast
ultimately show False
by fast
qed
}
hence "disjnt (dom (map_of (map (λv. (v, True)) (add_effects_of op'))))
(dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))"
unfolding disjnt_def Int_def
using nb⇩7
by simp
}
hence "dom (map_of (map (λv. (v, True)) (add_effects_of op'))) = ?Add"
and "dom (map_of (map (λv. (v, False)) (delete_effects_of op'))) = ?Delete"
and "disjnt (dom (map_of (map (λv. (v, True)) (add_effects_of op'))))
(dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))"
using dom_add dom_delete
by blast+
} note nb⇩8 = this
{
let ?Add = "set (effect_of op)"
let ?Delete = "(⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
have "∀(v, a) ∈ ?Add. map_of (effect_to_assignments op') (v, a) = Some True"
and "∀(v, a) ∈ ?Delete. map_of (effect_to_assignments op') (v, a) = Some False"
proof -
{
fix v a
assume "(v, a) ∈ ?Add"
hence "map_of (effect_to_assignments op') (v, a) = Some True"
unfolding effect_to_assignments_simp
using nb⇩6 map_of_defined_if_constructed_from_list_of_constant_assignments[of
"map (λv. (v, True)) (add_effects_of op')" True "add_effects_of op'"]
by force
}
moreover {
fix v a
assume "(v, a) ∈ ?Delete"
moreover have "(v, a) ∈ dom (map_of (map (λv. (v, False)) (delete_effects_of op')))"
using nb⇩8(2) calculation(1)
by argo
moreover have "(v, a) ∉ dom (map_of (map (λv. (v, True)) (add_effects_of op')))"
using nb⇩8
unfolding disjnt_def
using calculation(1)
by blast
moreover have "map_of (effect_to_assignments op') (v, a)
= map_of (map (λv. (v, False)) (delete_effects_of op')) (v, a)"
unfolding effect_to_assignments_simp map_of_append
using map_add_dom_app_simps(3)[OF calculation(3)]
by presburger
ultimately have "map_of (effect_to_assignments op') (v, a) = Some False"
using map_of_defined_if_constructed_from_list_of_constant_assignments[
of "map (λv. (v, False)) (delete_effects_of op')" False "delete_effects_of op'"]
nb⇩7
by auto
}
ultimately show "∀(v, a) ∈ ?Add. map_of (effect_to_assignments op') (v, a) = Some True"
and "∀(v, a) ∈ ?Delete. map_of (effect_to_assignments op') (v, a) = Some False"
by blast+
qed
} note nb⇩9 = this
{
fix v a
assume "(v, a) ∈ set (effect_of op)"
moreover have "∀(v, a) ∈ set (effect_of op). ∀(v', a') ∈ set (effect_of op). v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then is_valid_operator_op
unfolding is_valid_operator_sas_plus_def
by fast
ultimately have "map_of (effect_of op) v = Some a"
using map_of_constant_assignments_defined_if[of "effect_of op"]
by presburger
} note nb⇩1⇩0 = this
{
fix v a
assume v_a_in_effect_of_op: "(v, a) ∈ set (effect_of op)"
and "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v ≠ None"
moreover have "v ∈ set ?vs"
using is_valid_operator_op is_valid_operator_sas_plus_then(3) calculation(1)
by fastforce
moreover {
have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too
assms(1)
by blast
thm calculation(1) nb⇩6 assms(2)
moreover have "set (add_effects_of op') ⊆ set ((?Π)⇩𝒱)"
using assms(2) is_valid_problem_strips_operator_variable_sets(2)
calculation
by blast
moreover have "(v, a) ∈ set ((?Π)⇩𝒱)"
using v_a_in_effect_of_op nb⇩6 calculation(2)
by blast
ultimately have "a ∈ ℛ⇩+ Ψ v"
using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF
assms(1)]
by fast
}
ultimately have "(v, a) ∈ dom (φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op'))))"
using state_to_strips_state_dom_is[OF assms(1), of
"s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"]
by simp
} note nb⇩1⇩1 = this
{
fix v a
assume "(v, a) ∈ set (effect_of op)"
moreover have "v ∈ dom (map_of (effect_of op))"
unfolding dom_map_of_conv_image_fst
using calculation
by force
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v = Some a"
unfolding map_add_dom_app_simps(1)[OF calculation(2)] nb⇩1
using nb⇩1⇩0 calculation(1)
by blast
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v ≠ None"
using calculation(3)
by auto
moreover have "(v, a) ∈ dom (φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op'))))"
using nb⇩1⇩1 calculation(1, 4)
by presburger
ultimately have "(φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op')))) (v, a) = Some True"
using state_to_strips_state_range_is[OF assms(1)]
by simp
} note nb⇩1⇩2 = this
{
fix v a'
assume "(v, a') ∈ dom (map_of (effect_to_assignments op'))"
and "(v, a') ∈ (⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
moreover have "v ∈ dom (map_of (effect_of op))"
unfolding dom_map_of_conv_image_fst
using calculation(2)
by force
moreover have "v ∈ set ?vs"
using calculation(3) is_valid_operator_sas_plus_then(3) is_valid_operator_op
unfolding dom_map_of_conv_image_fst is_valid_operator_sas_plus_def
by fastforce
moreover obtain a where "(v, a) ∈ set (effect_of op)"
and "a' ∈ ℛ⇩+ Ψ v"
and "a' ≠ a"
using calculation(2)
by blast
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v = Some a"
unfolding map_add_dom_app_simps(1)[OF calculation(3)] nb⇩1
using nb⇩1⇩0 calculation(5)
by blast
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v ≠ None"
using calculation(8)
by auto
moreover have "(v, a') ∈ dom (φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op'))))"
using state_to_strips_state_dom_is[OF assms(1), of
"s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"] calculation(4, 6, 9)
by simp
ultimately have "(φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ op')))) (v, a') = Some False"
using state_to_strips_state_range_is[OF assms(1),
of v a' "s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"]
by simp
} note nb⇩1⇩3 = this
{
fix v a
assume "(v, a) ∈ dom ?t"
and "(v, a) ∉ dom (map_of (effect_to_assignments op'))"
moreover have "(v, a) ∈ dom ?s'"
using calculation(1, 2)
unfolding dom_map_add
by blast
moreover have "?t (v, a) = ?s' (v, a)"
unfolding map_add_dom_app_simps(3)[OF calculation(2)]..
ultimately have "?t (v, a) = Some (the (s v) = a)"
using state_to_strips_state_range_is[OF assms(1)]
by presburger
} note nb⇩1⇩4 = this
{
fix v a
assume "(v, a) ∈ dom ?t"
and v_a_not_in: "(v, a) ∉ dom (map_of (effect_to_assignments op'))"
moreover have "(v, a) ∈ dom ?s'"
using calculation(1, 2)
unfolding dom_map_add
by blast
moreover have "(v, a) ∈ (⋃ v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
using state_to_strips_state_dom_is[OF assms(1)] calculation(3)
by presburger
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "s v ≠ None" and "a ∈ ℛ⇩+ Ψ v"
using calculation(4)
by blast+
moreover {
have "dom (map_of (effect_to_assignments op')) = (⋃(v, a) ∈ set (effect_of op). { (v, a) })
∪ (⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
unfolding nb⇩2
by blast
also have "… = (⋃(v, a) ∈ set (effect_of op). { (v, a) }
∪ { (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
by blast
finally have "dom (map_of (effect_to_assignments op'))
= (⋃(v, a) ∈ set (effect_of op). { (v, a) }
∪ { (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
by auto
then have "(v, a) ∉ (⋃(v, a) ∈ set (effect_of op).
{ (v, a) | a. a ∈ ℛ⇩+ Ψ v })"
using v_a_not_in
by blast
}
moreover have "v ∉ dom (map_of (effect_of op))"
using dom_map_of_conv_image_fst calculation
by fastforce
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v = s v"
unfolding nb⇩1 map_add_dom_app_simps(3)[OF calculation(9)]
by simp
moreover have "(v, a) ∈ dom ?t'"
using state_to_strips_state_dom_is[OF assms(1), of
"s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"] calculation(5, 6, 7, 8, 10)
by simp
ultimately have "?t' (v, a) = Some (the (s v) = a)"
using state_to_strips_state_range_is[OF assms(1)]
by presburger
} note nb⇩1⇩5 = this
have nb⇩1⇩6: "dom ?t = (⋃ v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None }.
{ (v, a) | a. a ∈ (ℛ⇩+ Ψ v) })
∪ set (effect_of op)
∪ (⋃(v, a)∈set (effect_of op).
{(v, a') |a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a})"
unfolding dom_map_add nb⇩2
using state_to_strips_state_dom_is[OF assms(1), of s]
by auto
{
{
fix v a
assume "(v, a) ∈ dom ?t"
then consider (A) "(v, a) ∈ dom (φ⇩S Ψ s)"
| (B) "(v, a) ∈ dom (map_of (effect_to_assignments op'))"
by fast
hence "(v, a) ∈ dom ?t'"
proof (cases)
case A
then have "v ∈ set ((Ψ)⇩𝒱⇩+)" and "s v ≠ None" and "a ∈ ℛ⇩+ Ψ v"
unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
by blast+
thm map_add_None state_to_strips_state_dom_element_iff[OF assms(1)]
moreover have "(s ++ map_of (effect_of (φ⇩O¯ Ψ op'))) v ≠ None"
using calculation(2)
by simp
ultimately show ?thesis
unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
by blast
next
case B
then have "(v, a) ∈
set (effect_of op)
∪ (⋃(v, a)∈set (effect_of op). { (v, a') | a'. a' ∈ ℛ⇩+ Ψ v ∧ a' ≠ a })"
unfolding nb⇩2
by blast
then consider (B⇩1) "(v, a) ∈ set (effect_of op)"
| (B⇩2) "(v, a) ∈ (⋃(v, a)∈set (effect_of op).
{ (v, a') | a'. a' ∈ ℛ⇩+ Ψ v ∧ a' ≠ a })"
by blast
thm nb⇩1⇩2 nb⇩1⇩3 nb⇩2
thus ?thesis
proof (cases)
case B⇩1
then show ?thesis
using nb⇩1⇩2
by fast
next
case B⇩2
then show ?thesis
using nb⇩1⇩3 B
by blast
qed
qed
}
moreover {
let ?u = "s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"
fix v a
assume v_a_in_dom_t': "(v, a) ∈ dom ?t'"
thm nb⇩5
then have v_in_vs: "v ∈ set ((Ψ)⇩𝒱⇩+)"
and u_of_v_is_not_None: "?u v ≠ None"
and a_in_range_of_v: "a ∈ ℛ⇩+ Ψ v"
using state_to_strips_state_dom_element_iff[OF assms(1)]
v_a_in_dom_t'
by meson+
{
assume "(v, a) ∉ dom ?t"
then have contradiction: "(v, a) ∉
(⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None}. { (v, a) |a. a ∈ ℛ⇩+ Ψ v })
∪ set (effect_of op)
∪ (⋃(v, a)∈set (effect_of op). {(v, a') |a'. a' ∈ ℛ⇩+ Ψ v ∧ a' ≠ a})"
unfolding nb⇩1⇩6
by fast
hence False
proof (cases "map_of (effect_of (φ⇩O¯ Ψ op')) v = None")
case True
then have "s v ≠ None"
using u_of_v_is_not_None
by simp
then have "(v, a) ∈ (⋃v ∈ { v | v. v ∈ set ((Ψ)⇩𝒱⇩+) ∧ s v ≠ None}.
{ (v, a) |a. a ∈ ℛ⇩+ Ψ v })"
using v_in_vs a_in_range_of_v
by blast
thus ?thesis
using contradiction
by blast
next
case False
then have "v ∈ dom (map_of (effect_of op))"
using u_of_v_is_not_None nb⇩1
by blast
then obtain a' where map_of_effect_of_op_v_is: "map_of (effect_of op) v = Some a'"
by blast
then have v_a'_in: "(v, a') ∈ set (effect_of op)"
using map_of_SomeD
by fast
then show ?thesis
proof (cases "a = a'")
case True
then have "(v, a) ∈ set (effect_of op)"
using v_a'_in
by blast
then show ?thesis
using contradiction
by blast
next
case False
then have "(v, a) ∈ (⋃(v, a)∈set (effect_of op).
{(v, a') |a'. a' ∈ ℛ⇩+ Ψ v ∧ a' ≠ a})"
using v_a'_in calculation a_in_range_of_v
by blast
thus ?thesis
using contradiction
by fast
qed
qed
}
hence "(v, a) ∈ dom ?t"
by argo
}
moreover have "dom ?t ⊆ dom ?t'" and "dom ?t' ⊆ dom ?t"
subgoal
using calculation(1) subrelI[of "dom ?t" "dom ?t'"]
by fast
subgoal
using calculation(2) subrelI[of "dom ?t'" "dom ?t"]
by argo
done
ultimately have "dom ?t = dom ?t'"
by force
} note nb⇩1⇩7 = this
{
fix v a
assume v_a_in_dom_t: "(v, a) ∈ dom ?t"
hence "?t (v, a) = ?t' (v, a)"
proof (cases "(v, a) ∈ dom (map_of (effect_to_assignments op'))")
case True
then consider (A1) "(v, a) ∈ set (effect_of op)"
| (A2) "(v, a) ∈ (⋃(v, a) ∈ set (effect_of op).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
using nb⇩2
by fastforce
then show ?thesis
proof (cases)
case A1
then have "?t (v, a) = Some True"
unfolding map_add_dom_app_simps(1)[OF True]
using nb⇩9(1)
by fast
moreover have "?t' (v, a) = Some True"
using nb⇩1⇩2[OF A1].
ultimately show ?thesis..
next
case A2
then have "?t (v, a) = Some False"
unfolding map_add_dom_app_simps(1)[OF True]
using nb⇩9(2)
by blast
moreover have "?t' (v, a) = Some False"
using nb⇩1⇩3[OF True A2].
ultimately show ?thesis..
qed
next
case False
moreover have "?t (v, a) = Some (the (s v) = a)"
using nb⇩1⇩4[OF v_a_in_dom_t False].
moreover have "?t' (v, a) = Some (the (s v) = a)"
using nb⇩1⇩5[OF v_a_in_dom_t False].
ultimately show ?thesis
by argo
qed
} note nb⇩1⇩8 = this
moreover {
fix v a
assume "(v, a) ∈ dom ?t'"
hence "?t (v, a) = ?t' (v, a)"
using nb⇩1⇩7 nb⇩1⇩8
by presburger
}
ultimately have "?t ⊆⇩m ?t'" and "?t' ⊆⇩m ?t"
unfolding map_le_def
by fastforce+
thus ?thesis
using map_le_antisym[of ?t ?t']
by fast
qed
lemma sas_plus_equivalent_to_strips_i_a_XII:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op' ∈ set ops'. op' ∈ set ((φ Ψ)⇩𝒪)"
shows "execute_parallel_operator (φ⇩S Ψ s) ops'
= φ⇩S Ψ (execute_parallel_operator_sas_plus s [φ⇩O¯ Ψ op'. op' ← ops'])"
using assms
proof (induction ops' arbitrary: s)
case Nil
then show ?case
unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def
by simp
next
case (Cons op' ops')
let ?Π = "φ Ψ"
let ?t' = "(φ⇩S Ψ s) ++ map_of (effect_to_assignments op')"
and ?t = "s ++ map_of (effect_of (φ⇩O¯ Ψ op'))"
have nb⇩1: "?t' = φ⇩S Ψ ?t"
using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1)] Cons.prems(2)
by force
{
have "∀op' ∈ set ops'. op' ∈ set (strips_problem.operators_of ?Π)"
using Cons.prems(2)
by simp
then have "execute_parallel_operator (φ⇩S Ψ ?t) ops'
= φ⇩S Ψ (execute_parallel_operator_sas_plus ?t [φ⇩O¯ Ψ x. x ← ops'])"
using Cons.IH[OF Cons.prems(1), of ?t]
by fastforce
hence "execute_parallel_operator ?t' ops'
= φ⇩S Ψ (execute_parallel_operator_sas_plus ?t [φ⇩O¯ Ψ x. x ← ops'])"
using nb⇩1
by argo
}
thus ?case
by simp
qed
lemma sas_plus_equivalent_to_strips_i_a_XIII:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op' ∈ set ops'. op' ∈ set ((φ Ψ)⇩𝒪)"
and "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan
(execute_parallel_operator (φ⇩S Ψ I) ops') π"
shows "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan
(φ⇩S Ψ (execute_parallel_operator_sas_plus I [φ⇩O¯ Ψ op'. op' ← ops'])) π"
proof -
let ?I' = "(φ⇩S Ψ I)"
and ?G' = "φ⇩S Ψ G"
and ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
and ?Π = "φ Ψ"
let ?J = "execute_parallel_operator_sas_plus I ?ops"
{
fix v a
assume "(v, a) ∈ dom ?G'"
then have "?G' (v, a) = execute_parallel_plan
(execute_parallel_operator ?I' ops') π (v, a)"
using assms(3)
unfolding map_le_def
by auto
hence "?G' (v, a) = execute_parallel_plan (φ⇩S Ψ ?J) π (v, a)"
using sas_plus_equivalent_to_strips_i_a_XII[OF assms(1, 2)]
by simp
}
thus ?thesis
unfolding map_le_def
by fast
qed
lemma sas_plus_equivalent_to_strips_i_a:
assumes "is_valid_problem_sas_plus Ψ"
and "dom I ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom I. the (I v) ∈ ℛ⇩+ Ψ v"
and "dom G ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom G. the (G v) ∈ ℛ⇩+ Ψ v"
and "∀ops' ∈ set π. ∀op' ∈ set ops'. op' ∈ set ((φ Ψ)⇩𝒪)"
and "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan (φ⇩S Ψ I) π"
shows "G ⊆⇩m execute_parallel_plan_sas_plus I (φ⇩P¯ Ψ π)"
proof -
let ?vs = "variables_of Ψ"
and ?ψ = "φ⇩P¯ Ψ π"
show ?thesis
using assms
proof (induction π arbitrary: I)
case Nil
then have "(φ⇩S Ψ G) ⊆⇩m (φ⇩S Ψ I)"
by fastforce
then have "G ⊆⇩m I"
using state_to_strips_state_map_le_iff[OF assms(1, 4, 5)]
by blast
thus ?case
unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_parallel_plan_to_sas_plus_parallel_plan_def
by fastforce
next
case (Cons ops' π)
let ?D = "range_of Ψ"
and ?Π = "φ Ψ"
and ?I' = "φ⇩S Ψ I"
and ?G' = "φ⇩S Ψ G"
let ?ops = "[φ⇩O¯ Ψ op'. op' ← ops']"
let ?J = "execute_parallel_operator_sas_plus I ?ops"
and ?J' = "execute_parallel_operator ?I' ops'"
have nb⇩1: "set ops' ⊆ set ((?Π)⇩𝒪)"
using Cons.prems(6)
unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def list_all_iff ListMem_iff
by fastforce
{
fix op
assume "op ∈ set ?ops"
moreover obtain op' where "op' ∈ set ops'" and "op = φ⇩O¯ Ψ op'"
using calculation
by auto
moreover have "op' ∈ set ((?Π)⇩𝒪)"
using nb⇩1 calculation(2)
by blast
moreover obtain op'' where "op'' ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = φ⇩O Ψ op''"
using calculation(4)
by auto
moreover have "op = op''"
using sas_plus_operator_inverse_is[OF assms(1) calculation(5)] calculation(3, 6)
by presburger
ultimately have "op ∈ set ((Ψ)⇩𝒪⇩+) ∧ (∃op' ∈ set ops'. op' = φ⇩O Ψ op)"
by blast
} note nb⇩2 = this
{
fix op v a
assume "op ∈ set ((Ψ)⇩𝒪⇩+)" and "(v, a) ∈ set (effect_of op)"
moreover have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using nb⇩2 calculation(1)
by blast
moreover have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3)
by blast
ultimately have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using is_valid_operator_sas_plus_then(3)
by fastforce
} note nb⇩3 = this
{
fix op
assume "op ∈ set ?ops"
then have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using nb⇩2
by blast
then have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) Cons.prems(1)
by blast
hence "∀(v, a) ∈ set (effect_of op). v ∈ set ((Ψ)⇩𝒱⇩+)
∧ a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(3,4)
by fast
} note nb⇩4 = this
show ?case
proof (cases "STRIPS_Semantics.are_all_operators_applicable ?I' ops'
∧ STRIPS_Semantics.are_all_operator_effects_consistent ops'")
case True
{
{
have "dom I ⊆ set ((Ψ)⇩𝒱⇩+)"
using Cons.prems(2)
by blast
hence "(φ⇩S¯ Ψ ?I') = I"
using strips_state_to_state_inverse_is[OF
Cons.prems(1) _ Cons.prems(3)]
by argo
}
then have "are_all_operators_applicable_in I ?ops
∧ are_all_operator_effects_consistent ?ops"
using sas_plus_equivalent_to_strips_i_a_IV[OF assms(1) nb⇩1, of I] True
by simp
moreover have "(φ⇩P¯ Ψ (ops' # π)) = ?ops # (φ⇩P¯ Ψ π)"
unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by simp
ultimately have "execute_parallel_plan_sas_plus I (φ⇩P¯ Ψ (ops' # π))
= execute_parallel_plan_sas_plus ?J (φ⇩P¯ Ψ π)"
by force
} note nb⇩5 = this
{
have dom_J_subset_eq_vs: "dom ?J ⊆ set ((Ψ)⇩𝒱⇩+)"
using sas_plus_equivalent_to_strips_i_a_IX[OF Cons.prems(2)] nb⇩2 nb⇩4
by blast
moreover {
have "set ((Ψ)⇩𝒱⇩+) ⊆ dom (range_of Ψ)"
using is_valid_problem_sas_plus_then(1)[OF assms(1)]
by fastforce
moreover have "∀v ∈ dom I. the (I v) ∈ set (the (range_of Ψ v))"
using Cons.prems(2, 3) assms(1) set_the_range_of_is_range_of_sas_plus_if
by force
moreover have "∀op ∈ set ?ops. ∀(v, a) ∈ set (effect_of op).
v ∈ set ((Ψ)⇩𝒱⇩+) ∧ a ∈ set (the (?D v))"
using set_the_range_of_is_range_of_sas_plus_if assms(1) nb⇩4
by fastforce
moreover have v_in_dom_J_range: "∀v ∈ dom ?J. the (?J v) ∈ set (the (?D v))"
using sas_plus_equivalent_to_strips_i_a_X[of
I "set ((Ψ)⇩𝒱⇩+)" ?D ?ops, OF Cons.prems(2)] calculation(1, 2, 3)
by fastforce
{
fix v
assume "v ∈ dom ?J"
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using nb⇩2 calculation dom_J_subset_eq_vs
by blast
moreover have "set (the (range_of Ψ v)) = ℛ⇩+ Ψ v"
using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
calculation(2)
by presburger
ultimately have "the (?J v) ∈ ℛ⇩+ Ψ v"
using nb⇩3 v_in_dom_J_range
by blast
}
ultimately have "∀v ∈ dom ?J. the (?J v) ∈ ℛ⇩+ Ψ v"
by fast
}
moreover have "∀ops' ∈ set π. ∀op'∈set ops'. op' ∈ set ((φ Ψ)⇩𝒪)"
using Cons.prems(6)
by simp
moreover {
have "?G' ⊆⇩m execute_parallel_plan ?J' π"
using Cons.prems(7) True
by auto
hence "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan (φ⇩S Ψ ?J) π"
using sas_plus_equivalent_to_strips_i_a_XIII[OF Cons.prems(1)] nb⇩1
by blast
}
ultimately have "G ⊆⇩m execute_parallel_plan_sas_plus I (φ⇩P¯ Ψ (ops' # π))"
using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)] Cons.prems(6) nb⇩5
by presburger
}
thus ?thesis.
next
case False
then have "?G' ⊆⇩m ?I'"
using Cons.prems(7)
by force
moreover {
have "dom I ⊆ set ?vs"
using Cons.prems(2)
by simp
hence "¬(are_all_operators_applicable_in I ?ops
∧ are_all_operator_effects_consistent ?ops)"
using sas_plus_equivalent_to_strips_i_a_VIII[OF Cons.prems(1) _ Cons.prems(3) nb⇩1]
False
by force
}
moreover {
have "(φ⇩P¯ Ψ (ops' # π)) = ?ops # (φ⇩P¯ Ψ π)"
unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by simp
hence "G ⊆⇩m execute_parallel_plan_sas_plus I (?ops # (φ⇩P¯ Ψ π))
⟷ G ⊆⇩m I"
using calculation(2)
by force
}
ultimately show ?thesis
using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)]
unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by force
qed
qed
qed
lemma sas_plus_equivalent_to_strips_i:
assumes "is_valid_problem_sas_plus Ψ"
and "STRIPS_Semantics.is_parallel_solution_for_problem
(φ Ψ) π"
shows "goal_of Ψ ⊆⇩m execute_parallel_plan_sas_plus
(sas_plus_problem.initial_of Ψ) (φ⇩P¯ Ψ π)"
proof -
let ?vs = "variables_of Ψ"
and ?I = "initial_of Ψ"
and ?G = "goal_of Ψ"
let ?Π = "φ Ψ"
let ?G' = "strips_problem.goal_of ?Π"
and ?I' = "strips_problem.initial_of ?Π"
let ?ψ = "φ⇩P¯ Ψ π"
have "dom ?I ⊆ set ?vs"
using is_valid_problem_sas_plus_then(3) assms(1)
by auto
moreover have "∀v ∈ dom ?I. the (?I v) ∈ ℛ⇩+ Ψ v"
using is_valid_problem_sas_plus_then(4) assms(1) calculation
by auto
moreover have "dom ?G ⊆ set ?vs" and "∀v ∈ dom ?G. the (?G v) ∈ ℛ⇩+ Ψ v"
using is_valid_problem_sas_plus_then(5, 6) assms(1)
by blast+
moreover have "∀ops'∈set π. ∀op'∈set ops'. op' ∈ set ((?Π)⇩𝒪)"
using is_parallel_solution_for_problem_operator_set[OF assms(2)]
by simp
moreover {
have "?G' ⊆⇩m execute_parallel_plan ?I' π"
using assms(2)
unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def..
moreover have "?G' = φ⇩S Ψ ?G" and "?I' = φ⇩S Ψ ?I"
by simp+
ultimately have "(φ⇩S Ψ ?G) ⊆⇩m execute_parallel_plan (φ⇩S Ψ ?I) π"
by simp
}
ultimately show ?thesis
using sas_plus_equivalent_to_strips_i_a[OF assms(1)]
by simp
qed
lemma sas_plus_equivalent_to_strips_ii:
assumes "is_valid_problem_sas_plus Ψ"
and "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) π"
shows "list_all (list_all (λop. ListMem op (operators_of Ψ))) (φ⇩P¯ Ψ π)"
proof -
let ?Π = "φ Ψ"
let ?ops = "operators_of Ψ"
and ?ψ = "φ⇩P¯ Ψ π"
have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
by simp
have nb⇩1: "∀op' ∈ set ((?Π)⇩𝒪). (∃op ∈ set ?ops. op' = (φ⇩O Ψ op))"
by auto
{
fix ops' op' op
assume "ops' ∈ set π" and "op' ∈ set ops'"
then have "op' ∈ set (strips_problem.operators_of ?Π)"
using is_parallel_solution_for_problem_operator_set[OF assms(2)]
by simp
then obtain op where "op ∈ set ((Ψ)⇩𝒪⇩+)" and "op' = (φ⇩O Ψ op)"
by auto
then have "(φ⇩O¯ Ψ op') ∈ set ((Ψ)⇩𝒪⇩+)"
using sas_plus_operator_inverse_is[OF assms(1)]
by presburger
}
thus ?thesis
unfolding list_all_iff ListMem_iff
strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_op_to_sasp_def
strips_op_to_sasp_def
by auto
qed
text ‹ We now show that for a parallel solution \<^term>‹π› of \<^term>‹Π› the SAS+ plan
\<^term>‹ψ ≡ φ⇩P¯ Ψ π› yielded by the STRIPS to SAS+ plan transformation is a solution for
\<^term>‹Ψ›. The proof uses the definition of parallel STRIPS solutions and shows that the
execution of \<^term>‹ψ› on the initial state of the SAS+ problem yields a state satisfying the
problem's goal state, i.e.
@{text[display, indent=4]"G ⊆⇩m execute_parallel_plan_sas_plus I ψ"}
and by showing that all operators in all parallel operators of \<^term>‹ψ› are operators of the
problem. ›
theorem
sas_plus_equivalent_to_strips:
assumes "is_valid_problem_sas_plus Ψ"
and "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) π"
shows "is_parallel_solution_for_problem Ψ (φ⇩P¯ Ψ π)"
proof -
let ?I = "initial_of Ψ"
and ?G = "goal_of Ψ"
and ?ops = "operators_of Ψ"
and ?ψ = "φ⇩P¯ Ψ π"
show ?thesis
unfolding is_parallel_solution_for_problem_def Let_def
proof (rule conjI)
show "?G ⊆⇩m execute_parallel_plan_sas_plus ?I ?ψ"
using sas_plus_equivalent_to_strips_i[OF assms].
next
show "list_all (list_all (λop. ListMem op ?ops)) ?ψ"
using sas_plus_equivalent_to_strips_ii[OF assms].
qed
qed
private lemma strips_equivalent_to_sas_plus_i_a_I:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
and "op' ∈ set [φ⇩O Ψ op. op ← ops]"
obtains op where "op ∈ set ops"
and "op' = φ⇩O Ψ op"
proof -
let ?Π = "φ Ψ"
let ?ops = "operators_of Ψ"
obtain op where "op ∈ set ops" and "op' = φ⇩O Ψ op"
using assms(3)
by auto
thus ?thesis
using that
by blast
qed
private corollary strips_equivalent_to_sas_plus_i_a_II:
assumes"is_valid_problem_sas_plus Ψ"
and "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
and "op' ∈ set [φ⇩O Ψ op. op ← ops]"
shows "op' ∈ set ((φ Ψ)⇩𝒪)"
and "is_valid_operator_strips (φ Ψ) op'"
proof -
let ?Π = "φ Ψ"
let ?ops = "operators_of Ψ"
and ?ops' = "strips_problem.operators_of ?Π"
obtain op where op_in: "op ∈ set ops" and op'_is: "op' = φ⇩O Ψ op"
using strips_equivalent_to_sas_plus_i_a_I[OF assms].
then have nb: "op' ∈ set ((φ Ψ)⇩𝒪)"
using assms(2) op_in op'_is
by fastforce
thus "op' ∈ set ((φ Ψ)⇩𝒪)"
and "is_valid_operator_strips ?Π op'"
proof -
have "∀op' ∈ set ?ops'. is_valid_operator_strips ?Π op'"
using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms(1)]
unfolding list_all_iff.
thus "is_valid_operator_strips ?Π op'"
using nb
by fastforce
qed fastforce
qed
lemma strips_equivalent_to_sas_plus_i_a_III:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
shows "execute_parallel_operator (φ⇩S Ψ s) [φ⇩O Ψ op. op ← ops]
= (φ⇩S Ψ (execute_parallel_operator_sas_plus s ops))"
proof -
{
fix op s
assume "op ∈ set ((Ψ)⇩𝒪⇩+)"
moreover have "(φ⇩O Ψ op) ∈ set ((φ Ψ)⇩𝒪)"
using calculation
by simp
moreover have "(φ⇩S Ψ s) ++ map_of (effect_to_assignments (φ⇩O Ψ op))
= (φ⇩S Ψ (s ++ map_of (effect_of (φ⇩O¯ Ψ (φ⇩O Ψ op)))))"
using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1) calculation(2)]
by blast
moreover have "(φ⇩O¯ Ψ (φ⇩O Ψ op)) = op"
using sas_plus_operator_inverse_is[OF assms(1) calculation(1)].
ultimately have "(φ⇩S Ψ s) ⪢ (φ⇩O Ψ op)
= (φ⇩S Ψ (s ⪢⇩+ op))"
unfolding execute_operator_def execute_operator_sas_plus_def
by simp
} note nb⇩1 = this
show ?thesis
using assms
proof (induction ops arbitrary: s)
case Nil
then show ?case
unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def
by simp
next
case (Cons op ops)
let ?t = "s ⪢⇩+ op"
let ?s' = "φ⇩S Ψ s"
and ?ops' = "[φ⇩O Ψ op. op ← op # ops]"
let ?t' = "?s' ⪢ (φ⇩O Ψ op)"
have "execute_parallel_operator ?s' ?ops'
= execute_parallel_operator ?t' [φ⇩O Ψ x. x ← ops]"
unfolding execute_operator_def
by simp
moreover have "(φ⇩S Ψ (execute_parallel_operator_sas_plus s (op # ops)))
= (φ⇩S Ψ (execute_parallel_operator_sas_plus ?t ops))"
unfolding execute_operator_sas_plus_def
by simp
moreover {
have "?t' = (φ⇩S Ψ ?t)"
using nb⇩1 Cons.prems(2)
by simp
hence "execute_parallel_operator ?t'[φ⇩O Ψ x. x ← ops]
= (φ⇩S Ψ (execute_parallel_operator_sas_plus ?t ops))"
using Cons.IH[of ?t] Cons.prems
by simp
}
ultimately show ?case
by argo
qed
qed
private lemma strips_equivalent_to_sas_plus_i_a_IV:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
and "are_all_operators_applicable_in I ops
∧ are_all_operator_effects_consistent ops"
shows "STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ I) [φ⇩O Ψ op. op ← ops]
∧ STRIPS_Semantics.are_all_operator_effects_consistent [φ⇩O Ψ op. op ← ops]"
proof -
let ?vs = "variables_of Ψ"
and ?ops = "operators_of Ψ"
let ?I' = "φ⇩S Ψ I"
and ?ops' = "[φ⇩O Ψ op. op ← ops]"
have nb⇩1: "∀op ∈ set ops. is_operator_applicable_in I op"
using assms(3)
unfolding are_all_operators_applicable_in_def list_all_iff
by blast
have nb⇩2: "∀op ∈ set ops. is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1, 2)
unfolding is_valid_operator_sas_plus_def
by auto
have nb⇩3: "∀op ∈ set ops. map_of (precondition_of op) ⊆⇩m I"
using nb⇩1
unfolding is_operator_applicable_in_def list_all_iff
by blast
{
fix op⇩1 op⇩2
assume "op⇩1 ∈ set ops" and "op⇩2 ∈ set ops"
hence "are_operator_effects_consistent op⇩1 op⇩2"
using assms(3)
unfolding are_all_operator_effects_consistent_def list_all_iff
by blast
} note nb⇩4 = this
{
fix op⇩1 op⇩2
assume "op⇩1 ∈ set ops" and "op⇩2 ∈ set ops"
hence "∀(v, a) ∈ set (effect_of op⇩1). ∀(v', a') ∈ set (effect_of op⇩2).
v ≠ v' ∨ a = a'"
using nb⇩4
unfolding are_operator_effects_consistent_def Let_def list_all_iff
by presburger
} note nb⇩5 = this
{
fix op⇩1' op⇩2' I
assume "op⇩1' ∈ set ?ops'"
and "op⇩2' ∈ set ?ops'"
and "∃(v, a) ∈ set (add_effects_of op⇩1'). ∃(v', a') ∈ set (delete_effects_of op⇩2').
(v, a) = (v', a')"
moreover obtain op⇩1 op⇩2
where "op⇩1 ∈ set ops"
and "op⇩1' = φ⇩O Ψ op⇩1"
and "op⇩2 ∈ set ops"
and "op⇩2' = φ⇩O Ψ op⇩2"
using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)] calculation(1, 2)
by auto
moreover have "is_valid_operator_sas_plus Ψ op⇩1"
and is_valid_operator_op⇩2: "is_valid_operator_sas_plus Ψ op⇩2"
using calculation(4, 6) nb⇩2
by blast+
moreover obtain v v' a a'
where "(v, a) ∈ set (add_effects_of op⇩1')"
and "(v', a') ∈ set (delete_effects_of op⇩2')"
and "(v, a) = (v', a')"
using calculation
by blast
moreover have "(v, a) ∈ set (effect_of op⇩1)"
using calculation(5, 10)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def Let_def
by fastforce
moreover have "v = v'" and "a = a'"
using calculation(12)
by simp+
moreover {
have "(v', a') ∈ (⋃(v, a) ∈ set (effect_of op⇩2).
{ (v, a') | a'. a' ∈ (ℛ⇩+ Ψ v) ∧ a' ≠ a })"
using sasp_op_to_strips_set_delete_effects_is
calculation(7, 9, 11)
by blast
then obtain v'' a'' where "(v'', a'') ∈ set (effect_of op⇩2)"
and "(v', a') ∈ { (v'', a''') | a'''. a''' ∈ (ℛ⇩+ Ψ v'') ∧ a''' ≠ a'' }"
by blast
moreover have "(v', a'') ∈ set (effect_of op⇩2)"
using calculation
by blast
moreover have "a' ∈ ℛ⇩+ Ψ v''" and "a' ≠ a''"
using calculation(1, 2)
by fast+
ultimately have "∃a''. (v', a'') ∈ set (effect_of op⇩2) ∧ a' ∈ (ℛ⇩+ Ψ v')
∧ a' ≠ a''"
by blast
}
moreover obtain a'' where "a' ∈ ℛ⇩+ Ψ v'"
and "(v', a'') ∈ set (effect_of op⇩2)"
and "a' ≠ a''"
using calculation(16)
by blast
moreover have "∃(v, a) ∈ set (effect_of op⇩1). (∃(v', a') ∈ set (effect_of op⇩2).
v = v' ∧ a ≠ a')"
using calculation(13, 14, 15, 17, 18, 19)
by blast
ultimately have "∃op⇩1 ∈ set ops. ∃op⇩2 ∈ set ops. ¬are_operator_effects_consistent op⇩1 op⇩2"
unfolding are_operator_effects_consistent_def list_all_iff
by fastforce
} note nb⇩6 = this
show ?thesis
proof (rule conjI)
{
fix op'
assume "op' ∈ set ?ops'"
moreover obtain op where op_in: "op ∈ set ops"
and op'_is: "op' = φ⇩O Ψ op"
and op'_in: "op' ∈ set ((φ Ψ)⇩𝒪)"
and is_valid_op': "is_valid_operator_strips (φ Ψ) op'"
using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)]
strips_equivalent_to_sas_plus_i_a_II[OF assms(1, 2)] calculation
by metis
moreover have is_valid_op: "is_valid_operator_sas_plus Ψ op"
using nb⇩2 calculation(2)..
{
fix v a
assume v_a_in_preconditions': "(v, a) ∈ set (strips_operator.precondition_of op')"
have v_a_in_preconditions: "(v, a) ∈ set (precondition_of op)"
using op'_is
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def Let_def
using v_a_in_preconditions'
by force
moreover have "v ∈ set ?vs" and "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(1,2) is_valid_op calculation(1)
by fastforce+
moreover {
have "∀(v, a) ∈ set (precondition_of op). ∀(v', a') ∈ set (precondition_of op).
v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then(5) is_valid_op
by fast
hence "map_of (precondition_of op) v = Some a"
using map_of_constant_assignments_defined_if[OF _ v_a_in_preconditions]
by blast
}
moreover have "v ∈ dom (map_of (precondition_of op))"
using calculation(4)
by blast
moreover have "I v = Some a"
using nb⇩3
unfolding map_le_def
using op_in calculation(4, 5)
by metis
moreover have "(v, a) ∈ dom ?I'"
using state_to_strips_state_dom_element_iff[OF assms(1)]
calculation(2, 3, 6)
by simp
ultimately have "?I' (v, a) = Some True"
using state_to_strips_state_range_is[OF assms(1)]
by simp
}
hence "STRIPS_Representation.is_operator_applicable_in ?I' op'"
unfolding
STRIPS_Representation.is_operator_applicable_in_def
Let_def list_all_iff
by fast
}
thus "are_all_operators_applicable ?I' ?ops'"
unfolding are_all_operators_applicable_def list_all_iff
by blast
next
{
fix op⇩1' op⇩2'
assume op⇩1'_in_ops': "op⇩1' ∈ set ?ops'" and op⇩2'_in_ops': "op⇩2' ∈ set ?ops'"
have "STRIPS_Semantics.are_operator_effects_consistent op⇩1' op⇩2'"
unfolding STRIPS_Semantics.are_operator_effects_consistent_def Let_def
proof (rule conjI)
show "¬list_ex (λx. list_ex ((=) x) (delete_effects_of op⇩2'))
(add_effects_of op⇩1')"
proof (rule ccontr)
assume "¬¬list_ex (λv. list_ex ((=) v) (delete_effects_of op⇩2'))
(add_effects_of op⇩1')"
then have "∃(v, a) ∈ set (delete_effects_of op⇩2').
∃(v', a') ∈ set (add_effects_of op⇩1'). (v, a) = (v', a')"
unfolding list_ex_iff
by fastforce
then obtain op⇩1 op⇩2 where "op⇩1 ∈ set ops"
and "op⇩2 ∈ set ops"
and "¬are_operator_effects_consistent op⇩1 op⇩2"
using nb⇩6[OF op⇩1'_in_ops' op⇩2'_in_ops']
by blast
thus False
using nb⇩4
by blast
qed
next
show "¬list_ex (λv. list_ex ((=) v) (add_effects_of op⇩2')) (delete_effects_of op⇩1')"
proof (rule ccontr)
assume "¬¬list_ex (λv. list_ex ((=) v) (add_effects_of op⇩2'))
(delete_effects_of op⇩1')"
then have "∃(v, a) ∈ set (delete_effects_of op⇩1').
∃(v', a') ∈ set (add_effects_of op⇩2'). (v, a) = (v', a')"
unfolding list_ex_iff
by fastforce
then obtain op⇩1 op⇩2 where "op⇩1 ∈ set ops"
and "op⇩2 ∈ set ops"
and "¬are_operator_effects_consistent op⇩1 op⇩2"
using nb⇩6[OF op⇩2'_in_ops' op⇩1'_in_ops']
by blast
thus False
using nb⇩4
by blast
qed
qed
}
thus "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
by blast
qed
qed
private lemma strips_equivalent_to_sas_plus_i_a_V:
assumes "is_valid_problem_sas_plus Ψ"
and "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
and "¬(are_all_operators_applicable_in s ops
∧ are_all_operator_effects_consistent ops)"
shows "¬(STRIPS_Semantics.are_all_operators_applicable (φ⇩S Ψ s) [φ⇩O Ψ op. op ← ops]
∧ STRIPS_Semantics.are_all_operator_effects_consistent [φ⇩O Ψ op. op ← ops])"
proof -
let ?vs = "variables_of Ψ"
and ?ops = "operators_of Ψ"
let ?s' = "φ⇩S Ψ s"
and ?ops' = "[φ⇩O Ψ op. op ← ops]"
{
fix op
assume "op ∈ set ops"
hence "∃op' ∈ set ?ops'. op' = φ⇩O Ψ op"
by simp
} note nb⇩1 = this
{
fix op
assume "op ∈ set ops"
then have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using assms(2)
by blast
then have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) assms(1)
unfolding is_valid_operator_sas_plus_def
by auto
hence "∀(v, a) ∈ set (precondition_of op). ∀(v', a') ∈ set (precondition_of op).
v ≠ v' ∨ a = a'"
using is_valid_operator_sas_plus_then(5)
unfolding is_valid_operator_sas_plus_def
by fast
} note nb⇩2 = this
{
consider (A) "¬are_all_operators_applicable_in s ops"
| (B) "¬are_all_operator_effects_consistent ops"
using assms(3)
by blast
hence "¬STRIPS_Semantics.are_all_operators_applicable ?s' ?ops'
∨ ¬STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
proof (cases)
case A
then obtain op where op_in: "op ∈ set ops"
and not_precondition_map_le_s: "¬(map_of (precondition_of op) ⊆⇩m s)"
using A
unfolding are_all_operators_applicable_in_def list_all_iff
is_operator_applicable_in_def
by blast
then obtain op' where op'_in: "op' ∈ set ?ops'" and op'_is: "op' = φ⇩O Ψ op"
using nb⇩1
by blast
have "¬are_all_operators_applicable ?s' ?ops'"
proof (rule ccontr)
assume "¬¬are_all_operators_applicable ?s' ?ops'"
then have all_operators_applicable: "are_all_operators_applicable ?s' ?ops'"
by simp
moreover {
fix v
assume "v ∈ dom (map_of (precondition_of op))"
moreover obtain a where "map_of (precondition_of op) v = Some a"
using calculation
by blast
moreover have "(v, a) ∈ set (precondition_of op)"
using map_of_SomeD[OF calculation(2)].
moreover have "(v, a) ∈ set (strips_operator.precondition_of op')"
using op'_is
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
using calculation(3)
by auto
moreover have "?s' (v, a) = Some True"
using all_operators_applicable calculation
unfolding are_all_operators_applicable_def
STRIPS_Representation.is_operator_applicable_in_def
is_operator_applicable_in_def Let_def list_all_iff
using op'_in
by fast
moreover have "(v, a) ∈ dom ?s'"
using calculation(5)
by blast
moreover have "(v, a) ∈ set (precondition_of op)"
using op'_is calculation(3)
unfolding sasp_op_to_strips_def Let_def
by fastforce
moreover have "v ∈ set ?vs"
and "a ∈ ℛ⇩+ Ψ v"
and "s v ≠ None"
using state_to_strips_state_dom_element_iff[OF assms(1)]
calculation(6)
by simp+
moreover have "?s' (v, a) = Some (the (s v) = a)"
using state_to_strips_state_range_is[OF
assms(1) calculation(6)].
moreover have "the (s v) = a"
using calculation(5, 11)
by fastforce
moreover have "s v = Some a"
using calculation(12) option.collapse[OF calculation(10)]
by argo
moreover have "map_of (precondition_of op) v = Some a"
using map_of_constant_assignments_defined_if[OF nb⇩2[OF op_in] calculation(7)].
ultimately have "map_of (precondition_of op) v = s v"
by argo
}
then have "map_of (precondition_of op) ⊆⇩m s"
unfolding map_le_def
by blast
thus False
using not_precondition_map_le_s
by simp
qed
thus ?thesis
by simp
next
case B
{
obtain op⇩1 op⇩2 v v' a a'
where "op⇩1 ∈ set ops"
and op⇩2_in: "op⇩2 ∈ set ops"
and v_a_in: "(v, a) ∈ set (effect_of op⇩1)"
and v'_a'_in: "(v', a') ∈ set (effect_of op⇩2)"
and v_is: "v = v'" and a_is: "a ≠ a'"
using B
unfolding are_all_operator_effects_consistent_def
are_operator_effects_consistent_def list_all_iff Let_def
by blast
moreover obtain op⇩1' op⇩2' where "op⇩1' ∈ set ?ops'" and "op⇩1' = φ⇩O Ψ op⇩1"
and "op⇩1' ∈ set ?ops'" and op⇩2'_is: "op⇩2' = φ⇩O Ψ op⇩2"
using nb⇩1[OF calculation(1)] nb⇩1[OF calculation(2)]
by blast
moreover have "(v, a) ∈ set (add_effects_of op⇩1')"
using calculation(3, 8)
unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
sasp_op_to_strips_def Let_def
by force
moreover {
have "is_valid_operator_sas_plus Ψ op⇩1"
using assms(2) calculation(1) is_valid_problem_sas_plus_then(2) assms(1)
unfolding is_valid_operator_sas_plus_def
by auto
moreover have "is_valid_operator_sas_plus Ψ op⇩2"
using sublocale_sas_plus_finite_domain_representation_ii(2)[
OF assms(1)] assms(2) op⇩2_in
by blast
moreover have "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(4) calculation v_a_in
unfolding is_valid_operator_sas_plus_def
by fastforce
ultimately have "(v, a) ∈ set (delete_effects_of op⇩2')"
using sasp_op_to_strips_set_delete_effects_is[of Ψ op⇩2]
v'_a'_in v_is a_is
using op⇩2'_is
by blast
}
ultimately have "∃op⇩1' ∈ set ?ops'. ∃op⇩2' ∈ set ?ops'.
∃(v, a) ∈ set (delete_effects_of op⇩2'). ∃(v', a') ∈ set (add_effects_of op⇩1').
(v, a) = (v', a')"
by fastforce
}
then have "¬STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def
STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff list_ex_iff Let_def
by blast
thus ?thesis
by simp
qed
}
thus ?thesis
by blast
qed
lemma strips_equivalent_to_sas_plus_i_a:
assumes "is_valid_problem_sas_plus Ψ"
and "dom I ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom I. the (I v) ∈ ℛ⇩+ Ψ v"
and "dom G ⊆ set ((Ψ)⇩𝒱⇩+)"
and "∀v ∈ dom G. the (G v) ∈ ℛ⇩+ Ψ v"
and "∀ops ∈ set ψ. ∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
and "G ⊆⇩m execute_parallel_plan_sas_plus I ψ"
shows "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan (φ⇩S Ψ I) (φ⇩P Ψ ψ)"
proof -
let ?Π = "φ Ψ"
and ?G' = "φ⇩S Ψ G"
show ?thesis
using assms
proof (induction ψ arbitrary: I)
case Nil
let ?I' = "φ⇩S Ψ I"
have "G ⊆⇩m I"
using Nil
by simp
moreover have "?G' ⊆⇩m ?I'"
using state_to_strips_state_map_le_iff[OF Nil.prems(1, 4, 5)]
calculation..
ultimately show ?case
unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sas_plus_parallel_plan_to_strips_parallel_plan_def
by simp
next
case (Cons ops ψ)
let ?vs = "variables_of Ψ"
and ?ops = "operators_of Ψ"
and ?J = "execute_parallel_operator_sas_plus I ops"
and ?π = "φ⇩P Ψ (ops # ψ)"
let ?I' = "φ⇩S Ψ I"
and ?J' = "φ⇩S Ψ ?J"
and ?ops' = "[φ⇩O Ψ op. op ← ops]"
{
fix op v a
assume "op ∈ set ops" and "(v, a) ∈ set (effect_of op)"
moreover have "op ∈ set ?ops"
using Cons.prems(6) calculation(1)
by simp
moreover have "is_valid_operator_sas_plus Ψ op"
using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3)
unfolding is_valid_operator_sas_plus_def
by auto
ultimately have "v ∈ set ((Ψ)⇩𝒱⇩+)"
and "a ∈ ℛ⇩+ Ψ v"
using is_valid_operator_sas_plus_then(3,4)
by fastforce+
} note nb⇩1 = this
show ?case
proof (cases "are_all_operators_applicable_in I ops
∧ are_all_operator_effects_consistent ops")
case True
{
have "(φ⇩P Ψ (ops # ψ)) = ?ops' # (φ⇩P Ψ ψ)"
unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
by simp
moreover have "∀op ∈ set ops. op ∈ set ((Ψ)⇩𝒪⇩+)"
using Cons.prems(6)
by simp
moreover have "STRIPS_Semantics.are_all_operators_applicable ?I' ?ops'"
and "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
using strips_equivalent_to_sas_plus_i_a_IV[OF Cons.prems(1) _ True] calculation
by blast+
ultimately have "execute_parallel_plan ?I' ?π
= execute_parallel_plan (execute_parallel_operator ?I' ?ops') (φ⇩P Ψ ψ)"
by fastforce
}
moreover
{
{
have "dom I ⊆ set (sas_plus_problem.variables_of Ψ)"
using Cons.prems(2)
by blast
moreover have "∀op ∈ set ops. ∀(v, a) ∈ set (effect_of op).
v ∈ set ((Ψ)⇩𝒱⇩+)"
using nb⇩1(1)
by blast
ultimately have "dom ?J ⊆ set ((Ψ)⇩𝒱⇩+)"
using sas_plus_equivalent_to_strips_i_a_IX[of I "set ?vs"]
by simp
} note nb⇩2 = this
moreover {
have "dom I ⊆ set (sas_plus_problem.variables_of Ψ)"
using Cons.prems(2)
by blast
moreover have "set (sas_plus_problem.variables_of Ψ)
⊆ dom (range_of Ψ)"
using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
by auto
moreover {
fix v
assume "v ∈ dom I"
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using Cons.prems(2) calculation
by blast
ultimately have "the (I v) ∈ set (the (range_of Ψ v))"
using Cons.prems(3)
using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
by blast
}
moreover have "∀op∈set ops. ∀(v, a)∈set (effect_of op).
v ∈ set (sas_plus_problem.variables_of Ψ) ∧ a ∈ set (the (range_of Ψ v))"
using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] nb⇩1(1) nb⇩1(2)
by force
moreover have nb⇩3: "∀v ∈ dom ?J. the (?J v) ∈ set (the (range_of Ψ v))"
using sas_plus_equivalent_to_strips_i_a_X[of I "set ?vs" "range_of Ψ" ops]
calculation
by fast
moreover {
fix v
assume "v ∈ dom ?J"
moreover have "v ∈ set ((Ψ)⇩𝒱⇩+)"
using nb⇩2 calculation
by blast
moreover have "set (the (range_of Ψ v)) = ℛ⇩+ Ψ v"
using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
calculation(2)
by presburger
ultimately have "the (?J v) ∈ ℛ⇩+ Ψ v"
using nb⇩3
by blast
}
ultimately have "∀v ∈ dom ?J. the (?J v) ∈ ℛ⇩+ Ψ v"
by fast
}
moreover have "∀ops∈set ψ. ∀op∈set ops. op ∈ set ?ops"
using Cons.prems(6)
by auto
moreover have "G ⊆⇩m execute_parallel_plan_sas_plus ?J ψ"
using Cons.prems(7) True
by simp
ultimately have "(φ⇩S Ψ G) ⊆⇩m execute_parallel_plan ?J' (φ⇩P Ψ ψ)"
using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)]
by fastforce
}
moreover have "execute_parallel_operator ?I' ?ops' = ?J'"
using assms(1) strips_equivalent_to_sas_plus_i_a_III[OF assms(1)] Cons.prems(6)
by auto
ultimately show ?thesis
by argo
next
case False
then have nb: "G ⊆⇩m I"
using Cons.prems(7)
by force
moreover {
have "?π = ?ops' # (φ⇩P Ψ ψ)"
unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
by auto
moreover have "set ?ops' ⊆ set (strips_problem.operators_of ?Π)"
using strips_equivalent_to_sas_plus_i_a_II(1)[OF assms(1)] Cons.prems(6)
by auto
moreover have "¬(STRIPS_Semantics.are_all_operators_applicable ?I' ?ops'
∧ STRIPS_Semantics.are_all_operator_effects_consistent ?ops')"
using strips_equivalent_to_sas_plus_i_a_V[OF assms(1) _ False] Cons.prems(6)
by force
ultimately have "execute_parallel_plan ?I' ?π = ?I'"
by auto
}
moreover have "?G' ⊆⇩m ?I'"
using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)] nb
by blast
ultimately show ?thesis
by presburger
qed
qed
qed
lemma strips_equivalent_to_sas_plus_i:
assumes "is_valid_problem_sas_plus Ψ"
and "is_parallel_solution_for_problem Ψ ψ"
shows "(strips_problem.goal_of (φ Ψ)) ⊆⇩m execute_parallel_plan
(strips_problem.initial_of (φ Ψ)) (φ⇩P Ψ ψ)"
proof -
let ?vs = "variables_of Ψ"
and ?ops = "operators_of Ψ"
and ?I = "initial_of Ψ"
and ?G = "goal_of Ψ"
let ?Π = "φ Ψ"
let ?I' = "strips_problem.initial_of ?Π"
and ?G' = "strips_problem.goal_of ?Π"
have "dom ?I ⊆ set ?vs"
using is_valid_problem_sas_plus_then(3) assms(1)
by auto
moreover have "∀v∈dom ?I. the (?I v) ∈ ℛ⇩+ Ψ v"
using is_valid_problem_sas_plus_then(4) assms(1) calculation
by auto
moreover have "dom ?G ⊆ set ((Ψ)⇩𝒱⇩+)"
using is_valid_problem_sas_plus_then(5) assms(1)
by auto
moreover have "∀v ∈ dom ?G. the (?G v) ∈ ℛ⇩+ Ψ v"
using is_valid_problem_sas_plus_then(6) assms(1)
by auto
moreover have "∀ops ∈ set ψ. ∀op ∈ set ops. op ∈ set ?ops"
using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)]
by fastforce
moreover have "?G ⊆⇩m execute_parallel_plan_sas_plus ?I ψ"
using assms(2)
unfolding is_parallel_solution_for_problem_def
by simp
ultimately show ?thesis
using strips_equivalent_to_sas_plus_i_a[OF assms(1), of ?I ?G ψ]
unfolding sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
state_to_strips_state_def
SAS_Plus_STRIPS.state_to_strips_state_def
by force
qed
lemma strips_equivalent_to_sas_plus_ii:
assumes "is_valid_problem_sas_plus Ψ"
and "is_parallel_solution_for_problem Ψ ψ"
shows "list_all (list_all (λop. ListMem op (strips_problem.operators_of (φ Ψ)))) (φ⇩P Ψ ψ)"
proof -
let ?ops = "operators_of Ψ"
let ?Π = "φ Ψ"
let ?ops' = "strips_problem.operators_of ?Π"
and ?π = "φ⇩P Ψ ψ"
have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
by simp
have nb⇩1: "∀op ∈ set ?ops. (∃op' ∈ set ?ops'. op' = (φ⇩O Ψ op))"
unfolding sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def Let_def
sasp_op_to_strips_def
by force
{
fix ops op op'
assume "ops ∈ set ψ" and "op ∈ set ops"
moreover have "op ∈ set ((Ψ)⇩𝒪⇩+)"
using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)]
calculation
by blast
moreover obtain op' where "op' ∈ set ?ops'" and "op' = (φ⇩O Ψ op)"
using nb⇩1 calculation(3)
by auto
ultimately have "(φ⇩O Ψ op) ∈ set ?ops'"
by blast
}
thus ?thesis
unfolding list_all_iff ListMem_iff Let_def
sas_plus_problem_to_strips_problem_def
SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
Let_def
by auto
qed
text ‹ The following lemma proves the complementary proposition to theorem
\ref{isathm:equivalence-parallel-strips-parallel-sas-plus}. Namely, given a parallel solution
\<^term>‹ψ› for a SAS+ problem, the transformation to a STRIPS plan \<^term>‹φ⇩P Ψ ψ› also is a solution
to the corresponding STRIPS problem \<^term>‹Π ≡ (φ Ψ)›. In this direction, we have to show that the
execution of the transformed plan reaches the goal state \<^term>‹G' ≡ strips_problem.goal_of Π›
of the corresponding STRIPS problem, i.e.
@{text[display, indent=4] "G' ⊆⇩m execute_parallel_plan I' π"}
and that all operators in the transformed plan \<^term>‹π› are operators of \<^term>‹Π›. ›
theorem
strips_equivalent_to_sas_plus:
assumes "is_valid_problem_sas_plus Ψ"
and "is_parallel_solution_for_problem Ψ ψ"
shows "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) (φ⇩P Ψ ψ)"
proof -
let ?Π = "φ Ψ"
let ?I' = "strips_problem.initial_of ?Π"
and ?G' = "strips_problem.goal_of ?Π"
and ?ops' = "strips_problem.operators_of ?Π"
and ?π = "φ⇩P Ψ ψ"
show ?thesis
unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def
proof (rule conjI)
show "?G' ⊆⇩m execute_parallel_plan ?I' ?π"
using strips_equivalent_to_sas_plus_i[OF assms]
by simp
next
show "list_all (list_all (λop. ListMem op ?ops')) ?π"
using strips_equivalent_to_sas_plus_ii[OF assms].
qed
qed
lemma embedded_serial_sas_plus_plan_operator_structure:
assumes "ops ∈ set (embed ψ)"
obtains op
where "op ∈ set ψ"
and "[φ⇩O Ψ op. op ← ops] = [φ⇩O Ψ op]"
proof -
let ?ψ' = "embed ψ"
{
have "?ψ' = [[op]. op ← ψ]"
by (induction ψ; force)
moreover obtain op where "ops = [op]" and "op ∈ set ψ"
using assms calculation
by fastforce
ultimately have "∃op ∈ set ψ. [φ⇩O Ψ op. op ← ops] = [φ⇩O Ψ op]"
by auto
}
thus ?thesis
using that
by meson
qed
private lemma serial_sas_plus_equivalent_to_serial_strips_i:
assumes "ops ∈ set (φ⇩P Ψ (embed ψ))"
obtains op where "op ∈ set ψ" and "ops = [φ⇩O Ψ op]"
proof -
let ?ψ' = "embed ψ"
{
have "set (φ⇩P Ψ (embed ψ)) = { [φ⇩O Ψ op. op ← ops] | ops. ops ∈ set ?ψ' }"
unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def set_map
using setcompr_eq_image
by blast
moreover obtain ops' where "ops' ∈ set ?ψ'" and "ops = [φ⇩O Ψ op. op ← ops']"
using assms(1) calculation
by blast
moreover obtain op where "op ∈ set ψ" and "ops = [φ⇩O Ψ op]"
using embedded_serial_sas_plus_plan_operator_structure calculation(2, 3)
by blast
ultimately have "∃op ∈ set ψ. ops = [φ⇩O Ψ op]"
by meson
}
thus ?thesis
using that..
qed
private lemma serial_sas_plus_equivalent_to_serial_strips_ii[simp]:
"concat (φ⇩P Ψ (embed ψ)) = [φ⇩O Ψ op. op ← ψ]"
proof -
let ?ψ' = "List_Supplement.embed ψ"
have "concat (φ⇩P Ψ ?ψ') = map (λop. φ⇩O Ψ op) (concat ?ψ')"
unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
map_concat
by blast
also have "… = map (λop. φ⇩O Ψ op) ψ"
unfolding concat_is_inverse_of_embed[of ψ]..
finally show "concat (φ⇩P Ψ (embed ψ)) = [φ⇩O Ψ op. op ← ψ]".
qed
text ‹ Having established the equivalence of parallel STRIPS and SAS+, we can now show the
equivalence in the serial case. The proof combines the
embedding theorem for serial SAS+ solutions (\ref{isathm:serial-sas-plus-embedding}), the parallel
plan equivalence theorem \ref{isathm:equivalence-parallel-sas-plus-parallel-strips}, and the
flattening theorem for parallel STRIPS plans (\ref{isathm:embedded-serial-plan-flattening-strips}).
More precisely, given a serial SAS+ solution \<^term>‹ψ› for a SAS+ problem \<^term>‹Ψ›, the embedding
theorem confirms that the embedded plan \<^term>‹embed ψ› is an equivalent parallel solution to
\<^term>‹Ψ›. By parallel plan equivalence, \<^term>‹π ≡ φ⇩P Ψ (embed ψ)› is a parallel solution for the
corresponding STRIPS problem \<^term>‹φ Ψ›. Moreover, since \<^term>‹embed ψ› is a plan consisting of
singleton parallel operators, the same is true for \<^term>‹π›. Hence, the flattening lemma applies
and \<^term>‹concat π› is a serial solution for \<^term>‹φ Ψ›. Since \<^term>‹concat› moreover can be shown
to be the inverse of \<^term>‹embed›, the term
@{text[display, indent=4] "concat π = concat (φ⇩P Ψ (embed ψ))"}
can be reduced to the intuitive form
@{text[display, indent=4] "π = [φ⇩O Ψ op. op ← ψ]"}
which concludes the proof. ›
theorem
serial_sas_plus_equivalent_to_serial_strips:
assumes "is_valid_problem_sas_plus Ψ"
and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ"
shows "STRIPS_Semantics.is_serial_solution_for_problem (φ Ψ) [φ⇩O Ψ op. op ← ψ]"
proof -
let ?ψ' = "embed ψ"
and ?Π = "φ Ψ"
let ?π' = "φ⇩P Ψ ?ψ'"
let ?π = "concat ?π'"
{
have "SAS_Plus_Semantics.is_parallel_solution_for_problem Ψ ?ψ'"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus[OF assms]
by simp
hence "STRIPS_Semantics.is_parallel_solution_for_problem ?Π ?π'"
using strips_equivalent_to_sas_plus[OF assms(1)]
by simp
}
moreover have "?π = [φ⇩O Ψ op. op ← ψ]"
by simp
moreover have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
moreover have "∀ops ∈ set ?π'. ∃op ∈ set ψ. ops = [φ⇩O Ψ op]"
using serial_sas_plus_equivalent_to_serial_strips_i[of _ Ψ ψ]
by metis
ultimately show ?thesis
using STRIPS_Semantics.flattening_lemma[of ?Π]
by metis
qed
lemma embedded_serial_strips_plan_operator_structure:
assumes "ops' ∈ set (embed π)"
obtains op
where "op ∈ set π" and "[φ⇩O¯ Π op. op ← ops'] = [φ⇩O¯ Π op]"
proof -
let ?π' = "embed π"
{
have "?π' = [[op]. op ← π]"
by (induction π; force)
moreover obtain op where "ops' = [op]" and "op ∈ set π"
using calculation assms
by fastforce
ultimately have "∃op ∈ set π. [φ⇩O¯ Π op. op ← ops'] = [φ⇩O¯ Π op]"
by auto
}
thus ?thesis
using that
by meson
qed
private lemma serial_strips_equivalent_to_serial_sas_plus_i:
assumes "ops ∈ set (φ⇩P¯ Π (embed π))"
obtains op where "op ∈ set π" and "ops = [φ⇩O¯ Π op]"
proof -
let ?π' = "embed π"
{
have "set (φ⇩P¯ Π (embed π)) = { [φ⇩O¯ Π op. op ← ops] | ops. ops ∈ set ?π' }"
unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_op_to_sasp_def set_map
using setcompr_eq_image
by blast
moreover obtain ops' where "ops' ∈ set ?π'" and "ops = [φ⇩O¯ Π op. op ← ops']"
using assms(1) calculation
by blast
moreover obtain op where "op ∈ set π" and "ops = [φ⇩O¯ Π op]"
using embedded_serial_strips_plan_operator_structure calculation(2, 3)
by blast
ultimately have "∃op ∈ set π. ops = [φ⇩O¯ Π op]"
by meson
}
thus ?thesis
using that..
qed
private lemma serial_strips_equivalent_to_serial_sas_plus_ii[simp]:
"concat (φ⇩P¯ Π (embed π)) = [φ⇩O¯ Π op. op ← π]"
proof -
let ?π' = "List_Supplement.embed π"
have "concat (φ⇩P¯ Π ?π') = map (λop. φ⇩O¯ Π op) (concat ?π')"
unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
strips_op_to_sasp_def
SAS_Plus_STRIPS.strips_op_to_sasp_def Let_def
map_concat
by simp
also have "… = map (λop. φ⇩O¯ Π op) π"
unfolding concat_is_inverse_of_embed[of π]..
finally show "concat (φ⇩P¯ Π (embed π)) = [φ⇩O¯ Π op. op ← π]".
qed
text ‹ Using the analogous lemmas for the opposite direction, we can show the counterpart to
theorem \ref{isathm:equivalence-serial-sas-plus-serial-strips} which shows that serial solutions
to STRIPS solutions can be transformed to serial SAS+ solutions via composition of embedding,
transformation and flattening. ›
theorem
serial_strips_equivalent_to_serial_sas_plus:
assumes "is_valid_problem_sas_plus Ψ"
and "STRIPS_Semantics.is_serial_solution_for_problem (φ Ψ) π"
shows "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ [φ⇩O¯ Ψ op. op ← π]"
proof -
let ?π' = "embed π"
and ?Π = "φ Ψ"
let ?ψ' = "φ⇩P¯ Ψ ?π'"
let ?ψ = "concat ?ψ'"
{
have "STRIPS_Semantics.is_parallel_solution_for_problem ?Π ?π'"
using embedding_lemma[OF
is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)] assms(2)].
hence "SAS_Plus_Semantics.is_parallel_solution_for_problem Ψ ?ψ'"
using sas_plus_equivalent_to_strips[OF assms(1)]
by simp
}
moreover have "?ψ = [φ⇩O¯ Ψ op. op ← π]"
by simp
moreover have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
moreover have "∀ops ∈ set ?ψ'. ∃op ∈ set π. ops = [φ⇩O¯ Ψ op]"
using serial_strips_equivalent_to_serial_sas_plus_i
by metis
ultimately show ?thesis
using flattening_lemma[OF assms(1)]
by metis
qed
subsection "Equivalence of SAS+ and STRIPS"
abbreviation bounded_plan_set
where "bounded_plan_set ops k ≡ { π. set π ⊆ set ops ∧ length π = k }"
definition bounded_solution_set_sas_plus'
:: "('variable, 'domain) sas_plus_problem
⇒ nat
⇒ ('variable, 'domain) sas_plus_plan set"
where "bounded_solution_set_sas_plus' Ψ k
≡ { ψ. is_serial_solution_for_problem Ψ ψ ∧ length ψ = k}"
abbreviation bounded_solution_set_sas_plus
:: "('variable, 'domain) sas_plus_problem
⇒ nat
⇒ ('variable, 'domain) sas_plus_plan set"
where "bounded_solution_set_sas_plus Ψ N
≡ (⋃k ∈ {0..N}. bounded_solution_set_sas_plus' Ψ k)"
definition bounded_solution_set_strips'
:: "('variable × 'domain) strips_problem
⇒ nat
⇒ ('variable × 'domain) strips_plan set"
where "bounded_solution_set_strips' Π k
≡ { π. STRIPS_Semantics.is_serial_solution_for_problem Π π ∧ length π = k }"
abbreviation bounded_solution_set_strips
:: "('variable × 'domain) strips_problem
⇒ nat
⇒ ('variable × 'domain) strips_plan set"
where "bounded_solution_set_strips Π N ≡ (⋃k ∈ {0..N}. bounded_solution_set_strips' Π k)"
lemma sasp_op_to_strips_injective:
assumes "(φ⇩O Ψ op⇩1) = (φ⇩O Ψ op⇩2)"
shows "op⇩1 = op⇩2"
proof -
let ?op⇩1' = "φ⇩O Ψ op⇩1"
and ?op⇩2' = "φ⇩O Ψ op⇩2"
{
have "strips_operator.precondition_of ?op⇩1' = strips_operator.precondition_of ?op⇩2'"
using assms
by argo
hence "sas_plus_operator.precondition_of op⇩1 = sas_plus_operator.precondition_of op⇩2"
unfolding sasp_op_to_strips_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
Let_def
by simp
}
moreover {
have "strips_operator.add_effects_of ?op⇩1' = strips_operator.add_effects_of ?op⇩2'"
using assms
unfolding sasp_op_to_strips_def Let_def
by argo
hence "sas_plus_operator.effect_of op⇩1 = sas_plus_operator.effect_of op⇩2"
unfolding sasp_op_to_strips_def Let_def
SAS_Plus_STRIPS.sasp_op_to_strips_def
by simp
}
ultimately show ?thesis
by simp
qed
lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a:
assumes "is_valid_problem_sas_plus Ψ"
shows "inj_on (λψ. [φ⇩O Ψ op. op ← ψ]) (bounded_plan_set (sas_plus_problem.operators_of Ψ) k)"
proof -
let ?ops = "sas_plus_problem.operators_of Ψ"
and ?φ⇩P = "λψ. [φ⇩O Ψ op. op ← ψ]"
let ?P = "bounded_plan_set ?ops"
{
fix ψ⇩1 ψ⇩2
assume ψ⇩1_in: "ψ⇩1 ∈ ?P k"
and ψ⇩2_in: "ψ⇩2 ∈ ?P k"
and φ⇩P_of_ψ⇩1_is_φ⇩P_of_ψ⇩2: "(?φ⇩P ψ⇩1) = (?φ⇩P ψ⇩2)"
hence "ψ⇩1 = ψ⇩2"
proof (induction k arbitrary: ψ⇩1 ψ⇩2)
case 0
then have "length ψ⇩1 = 0"
and "length ψ⇩2 = 0"
using ψ⇩1_in ψ⇩2_in
unfolding bounded_solution_set_sas_plus'_def
by blast+
then show ?case
by blast
next
case (Suc k)
moreover have "length ψ⇩1 = Suc k" and "length ψ⇩2 = Suc k"
using length_Suc_conv Suc(2, 3)
unfolding bounded_solution_set_sas_plus'_def
by blast+
moreover obtain op⇩1 ψ⇩1' where "ψ⇩1 = op⇩1 # ψ⇩1'"
and "set (op⇩1 # ψ⇩1') ⊆ set ?ops"
and "length ψ⇩1' = k"
using calculation(5) Suc(2)
unfolding length_Suc_conv
by blast
moreover obtain op⇩2 ψ⇩2' where "ψ⇩2 = op⇩2 # ψ⇩2'"
and "set (op⇩2 # ψ⇩2') ⊆ set ?ops"
and "length ψ⇩2' = k"
using calculation(6) Suc(3)
unfolding length_Suc_conv
by blast
moreover have "set ψ⇩1' ⊆ set ?ops" and "set ψ⇩2' ⊆ set ?ops"
using calculation(8, 11)
by auto+
moreover have "ψ⇩1' ∈ ?P k" and "ψ⇩2' ∈ ?P k"
using calculation(9, 12, 13, 14)
by fast+
moreover have "?φ⇩P ψ⇩1' = ?φ⇩P ψ⇩2'"
using Suc.prems(3) calculation(7, 10)
by fastforce
moreover have "ψ⇩1' = ψ⇩2'"
using Suc.IH[of ψ⇩1' ψ⇩2', OF calculation(15, 16, 17)]
by simp
moreover have "?φ⇩P ψ⇩1 = (φ⇩O Ψ op⇩1) # ?φ⇩P ψ⇩1'"
and "?φ⇩P ψ⇩2 = (φ⇩O Ψ op⇩2) # ?φ⇩P ψ⇩2'"
using Suc.prems(3) calculation(7, 10)
by fastforce+
moreover have "(φ⇩O Ψ op⇩1) = (φ⇩O Ψ op⇩2)"
using Suc.prems(3) calculation(17, 19, 20)
by simp
moreover have "op⇩1 = op⇩2"
using sasp_op_to_strips_injective[OF calculation(21)].
ultimately show ?case
by argo
qed
}
thus ?thesis
unfolding inj_on_def
by blast
qed
private corollary sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b:
assumes "is_valid_problem_sas_plus Ψ"
shows "inj_on (λψ. [φ⇩O Ψ op. op ← ψ]) (bounded_solution_set_sas_plus' Ψ k)"
proof -
let ?ops = "sas_plus_problem.operators_of Ψ"
and ?φ⇩P = "λψ. [φ⇩O Ψ op. op ← ψ]"
{
fix ψ
assume "ψ ∈ bounded_solution_set_sas_plus' Ψ k"
then have "set ψ ⊆ set ?ops"
and "length ψ = k"
unfolding bounded_solution_set_sas_plus'_def is_serial_solution_for_problem_def Let_def
list_all_iff ListMem_iff
by fast+
hence "ψ ∈ bounded_plan_set ?ops k"
by blast
}
hence "bounded_solution_set_sas_plus' Ψ k ⊆ bounded_plan_set ?ops k"
by blast
moreover have "inj_on ?φ⇩P (bounded_plan_set ?ops k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a[OF assms(1)].
ultimately show ?thesis
using inj_on_subset[of ?φ⇩P "bounded_plan_set ?ops k" "bounded_solution_set_sas_plus' Ψ k"]
by fast
qed
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c:
assumes "is_valid_problem_sas_plus Ψ"
shows "(λψ. [φ⇩O Ψ op. op ← ψ]) ` (bounded_solution_set_sas_plus' Ψ k)
= bounded_solution_set_strips' (φ Ψ) k"
proof -
let ?Π = "φ Ψ"
and ?φ⇩P = "λψ. [φ⇩O Ψ op. op ← ψ]"
let ?Sol⇩k = "bounded_solution_set_sas_plus' Ψ k"
and ?Sol⇩k' = "bounded_solution_set_strips' ?Π k"
{
assume "?φ⇩P ` ?Sol⇩k ≠ ?Sol⇩k'"
then consider (A) "∃π ∈ ?φ⇩P ` ?Sol⇩k. π ∉ ?Sol⇩k'"
| (B) "∃π ∈ ?Sol⇩k'. π ∉ ?φ⇩P ` ?Sol⇩k"
by blast
hence False
proof (cases)
case A
moreover obtain π where "π ∈ ?φ⇩P ` ?Sol⇩k" and "π ∉ ?Sol⇩k'"
using calculation
by blast
moreover obtain ψ where "length ψ = k"
and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ"
and "π = ?φ⇩P ψ"
using calculation(2)
unfolding bounded_solution_set_sas_plus'_def
by blast
moreover have "length π = k" and "STRIPS_Semantics.is_serial_solution_for_problem ?Π π"
subgoal
using calculation(4, 6) by auto
subgoal
using serial_sas_plus_equivalent_to_serial_strips
assms(1) calculation(5) calculation(6)
by blast
done
moreover have "π ∈ ?Sol⇩k'"
unfolding bounded_solution_set_strips'_def
using calculation(7, 8)
by simp
ultimately show ?thesis
by fast
next
case B
moreover obtain π where "π ∈ ?Sol⇩k'" and "π ∉ ?φ⇩P ` ?Sol⇩k"
using calculation
by blast
moreover have "STRIPS_Semantics.is_serial_solution_for_problem ?Π π"
and "length π = k"
using calculation(2)
unfolding bounded_solution_set_strips'_def
by simp+
moreover have "length [φ⇩O¯ Ψ op. op ← π] = k"
and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ [φ⇩O¯ Ψ op. op ← π]"
subgoal
using calculation(5)
by simp
subgoal
using serial_strips_equivalent_to_serial_sas_plus[OF assms(1)]
calculation(4)
by simp
done
moreover have "[φ⇩O¯ Ψ op. op ← π] ∈ ?Sol⇩k"
unfolding bounded_solution_set_sas_plus'_def
using calculation(6, 7)
by blast
moreover {
have "∀op ∈ set π. op ∈ set ((?Π)⇩𝒪)"
using calculation(4)
unfolding STRIPS_Semantics.is_serial_solution_for_problem_def list_all_iff ListMem_iff
by simp
hence "?φ⇩P [φ⇩O¯ Ψ op. op ← π] = π"
proof (induction π)
case (Cons op π)
moreover have "?φ⇩P [φ⇩O¯ Ψ op. op ← op # π]
= (φ⇩O Ψ (φ⇩O¯ Ψ op)) # ?φ⇩P [φ⇩O¯ Ψ op. op ← π]"
by simp
moreover have "op ∈ set ((?Π)⇩𝒪)"
using Cons.prems
by simp
moreover have "(φ⇩O Ψ (φ⇩O¯ Ψ op)) = op"
using strips_operator_inverse_is[OF assms(1) calculation(4)].
moreover have "?φ⇩P [φ⇩O¯ Ψ op. op ← π] = π"
using Cons.IH Cons.prems
by auto
ultimately show ?case
by argo
qed simp
}
moreover have "π ∈ ?φ⇩P ` ?Sol⇩k"
using calculation(8, 9)
by force
ultimately show ?thesis
by blast
qed
}
thus ?thesis
by blast
qed
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_d:
assumes "is_valid_problem_sas_plus Ψ"
shows "card (bounded_solution_set_sas_plus' Ψ k) ≤ card (bounded_solution_set_strips' (φ Ψ) k)"
proof -
let ?Π = "φ Ψ"
and ?φ⇩P = "λψ. [φ⇩O Ψ op. op ← ψ]"
let ?Sol⇩k = "bounded_solution_set_sas_plus' Ψ k"
and ?Sol⇩k' = "bounded_solution_set_strips' ?Π k"
have "card (?φ⇩P ` ?Sol⇩k) = card (?Sol⇩k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms(1)]
card_image
by blast
moreover have "?φ⇩P ` ?Sol⇩k = ?Sol⇩k'"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms(1)].
ultimately show ?thesis
by simp
qed
lemma bounded_plan_set_finite:
shows "finite { π. set π ⊆ set ops ∧ length π = k }"
proof (induction k)
case (Suc k)
let ?P = "{ π. set π ⊆ set ops ∧ length π = k }"
and ?P' = "{ π. set π ⊆ set ops ∧ length π = Suc k }"
let ?P'' = "(⋃op ∈ set ops. (⋃π ∈ ?P. { op # π }))"
{
have "∀op π. finite { op # π }"
by simp
then have "∀op. finite (⋃π ∈ ?P. { op # π })"
using finite_UN[of ?P] Suc
by blast
hence "finite ?P''"
using finite_UN[of "set ops"]
by blast
}
moreover {
{
fix π
assume "π ∈ ?P'"
moreover have "set π ⊆ set ops"
and "length π = Suc k"
using calculation
by simp+
moreover obtain op π' where "π = op # π'"
using calculation (3)
unfolding length_Suc_conv
by fast
moreover have "set π' ⊆ set ops" and "op ∈ set ops"
using calculation(2, 4)
by simp+
moreover have "length π' = k"
using calculation(3, 4)
by auto
moreover have "π' ∈ ?P"
using calculation(5, 7)
by blast
ultimately have "π ∈ ?P''"
by blast
}
hence "?P' ⊆ ?P''"
by blast
}
ultimately show ?case
using rev_finite_subset[of ?P'' ?P']
by blast
qed force
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a:
assumes "is_valid_problem_sas_plus Ψ"
shows "finite (bounded_solution_set_sas_plus' Ψ k)"
proof -
let ?Ops = "set ((Ψ)⇩𝒪⇩+)"
let ?Sol⇩k = "bounded_solution_set_sas_plus' Ψ k"
and ?P⇩k = "{ π. set π ⊆ ?Ops ∧ length π = k }"
{
fix ψ
assume "ψ ∈ ?Sol⇩k"
then have "length ψ = k" and "set ψ ⊆ ?Ops"
unfolding bounded_solution_set_sas_plus'_def
SAS_Plus_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
by fastforce+
hence "ψ ∈ ?P⇩k"
by blast
}
then have "?Sol⇩k ⊆ ?P⇩k"
by force
thus ?thesis
using bounded_plan_set_finite rev_finite_subset[of ?P⇩k ?Sol⇩k]
by auto
qed
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b:
assumes "is_valid_problem_sas_plus Ψ"
shows "finite (bounded_solution_set_strips' (φ Ψ) k)"
proof -
let ?Π = "φ Ψ"
let ?Ops = "set ((?Π)⇩𝒪)"
let ?Sol⇩k = "bounded_solution_set_strips' ?Π k"
and ?P⇩k = "{ π. set π ⊆ ?Ops ∧ length π = k }"
{
fix π
assume "π ∈ ?Sol⇩k"
then have "length π = k" and "set π ⊆ ?Ops"
unfolding bounded_solution_set_strips'_def
STRIPS_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
by fastforce+
hence "π ∈ ?P⇩k"
by blast
}
then have "?Sol⇩k ⊆ ?P⇩k"
by force
thus ?thesis
using bounded_plan_set_finite rev_finite_subset[of ?P⇩k ?Sol⇩k]
unfolding state_to_strips_state_def
SAS_Plus_STRIPS.state_to_strips_state_def operators_of_def
by blast
qed
text ‹ With the results on the equivalence of SAS+ and STRIPS solutions, we can now show that given
problems in both formalisms, the solution sets have the same size.
This is the property required by the definition of planning formalism equivalence presented earlier
in theorem \ref{thm:solution-sets-sas-plus-strips-f} (\autoref{sub:equivalence-sas-plus-strips}) and
thus end up with the desired equivalence result.
The proof uses the finiteness and disjunctiveness of the solution sets for either problem to be
able to equivalently transform the set cardinality over the union of sets of solutions with bounded
lengths into a sum over the cardinality of the sets of solutions with bounded length. Moreover,
since we know that for each SAS+ solution with a given length an equivalent STRIPS solution exists
in the solution set of the transformed problem with the same length, both sets must have the same
cardinality.
Hence the cardinality of the SAS+ solution set over all lengths up to a given upper bound \<^term>‹N›
has the same size as the solution set of the corresponding STRIPS problem over all length up to a
given upper bound \<^term>‹N›. ›
theorem
assumes "is_valid_problem_sas_plus Ψ"
shows "card (bounded_solution_set_sas_plus Ψ N)
= card (bounded_solution_set_strips (φ Ψ) N)"
proof -
let ?Π = "φ Ψ"
and ?R = "{0..N}"
have finite_R: "finite ?R"
by simp
moreover {
have "∀k ∈ ?R. finite (bounded_solution_set_sas_plus' Ψ k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a[OF
assms(1)]..
moreover have "∀j ∈ ?R. ∀k ∈ ?R. j ≠ k
⟶ bounded_solution_set_sas_plus' Ψ j
∩ bounded_solution_set_sas_plus' Ψ k = {}"
unfolding bounded_solution_set_sas_plus'_def
by blast
ultimately have "card (bounded_solution_set_sas_plus Ψ N)
= (∑k ∈ ?R. card (bounded_solution_set_sas_plus' Ψ k))"
using card_UN_disjoint
by blast
}
moreover {
have "∀k ∈ ?R. finite (bounded_solution_set_strips' ?Π k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b[OF
assms(1)]..
moreover have "∀j ∈ ?R. ∀k ∈ ?R. j ≠ k
⟶ bounded_solution_set_strips' ?Π j
∩ bounded_solution_set_strips' ?Π k = {}"
unfolding bounded_solution_set_strips'_def
by blast
ultimately have "card (bounded_solution_set_strips ?Π N)
= (∑k ∈ ?R. card (bounded_solution_set_strips' ?Π k))"
using card_UN_disjoint
by blast
}
moreover {
fix k
have "card (bounded_solution_set_sas_plus' Ψ k)
= card ((λψ. [φ⇩O Ψ op. op ← ψ])
` bounded_solution_set_sas_plus' Ψ k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms]
card_image[symmetric]
by blast
hence "card (bounded_solution_set_sas_plus' Ψ k)
= card (bounded_solution_set_strips' ?Π k)"
using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms]
by presburger
}
ultimately show ?thesis
by presburger
qed
end
end
Theory SAT_Plan_Base
theory SAT_Plan_Base
imports "List-Index.List_Index"
"Propositional_Proof_Systems.Formulas"
"STRIPS_Semantics"
"Map_Supplement" "List_Supplement"
"CNF_Semantics_Supplement" "CNF_Supplement"
begin
hide_const (open) Orderings.bot_class.bot
no_notation Orderings.bot_class.bot ("⊥")
hide_const (open) Transitive_Closure.trancl
no_notation Transitive_Closure.trancl ("(_⇧+)" [1000] 999)
hide_const (open) Relation.converse
no_notation Relation.converse ("(_¯)" [1000] 999)
section "The Basic SATPlan Encoding"
text ‹ We now move on to the formalization of the basic SATPlan encoding (see
\autoref{def:basic-sat-plan-encoding-strips-problem}).
The two major results that we will obtain here are the soundness and completeness result outlined
in \autoref{thm:soundness-and-completeness-satplan-base} in
\autoref{sub:soundness-completeness-satplan}.
Let in the following ‹Φ ≡ encode_to_sat Π t› denote the SATPlan encoding for a STRIPS problem ‹Π›
and makespan ‹t›. Let \<^term>‹k < t› and ‹I ≡ (Π)⇩I› be the initial state of ‹Π›, ‹G ≡ (Π)⇩G› be
its goal state, ‹𝒱 ≡ (Π)⇩𝒱› its variable set, and ‹𝒪 ≡ (Π)⇩𝒪› its operator set. ›
subsection "Encoding Function Definitions"
text ‹ Since the SATPlan encoding uses propositional variables for both operators and state
variables of the problem as well as time points, we define a datatype using separate constructors
---\<^term>‹State k n› for state variables resp. \<^term>‹Operator k n› for operator activation---to
facilitate case distinction.
The natural number values store the time index resp. the indexes of the variable or operator
within their lists in the problem representation.
% TODO Note on why formulas are used instead of CNF (simple representation and good basis; e.g.
% export to cnf lists using CNF_Formulas.cnf_lists) ›
datatype sat_plan_variable =
State nat nat
| Operator nat nat
text ‹ A SATPlan formula is a regular propositional formula over SATPlan variables. We add a type
synonym to improve readability. ›
type_synonym sat_plan_formula = "sat_plan_variable formula"
text ‹ We now continue with the concrete definitions used in the implementation of the SATPlan
encoding. State variables are encoded as literals over SATPlan variables using the ‹State›
constructor of \isaname{sat_plan_variable}. ›
definition encode_state_variable
:: "nat ⇒ nat ⇒ bool option ⇒ sat_plan_variable formula"
where "encode_state_variable t k v ≡ case v of
Some True ⇒ Atom (State t k)
| Some False ⇒ ❙¬ (Atom (State t k))"
text ‹ The initial state encoding (definition \ref{isadef:initial-state-encoding}) is a conjunction
of state variable encodings \<^term>‹A ≡ encode_state_variable 0 n b› with ‹n ≡ index vs v› and
\<^term>‹b ≡ I v = Some True› for all \<^term>‹v ∈ 𝒱›. As we can see below, the same function but
substituting the initial state with the goal state and zero with the makespan \<^term>‹t› produces the
goal state encoding (\ref{isadef:goal-state-encoding}).
Note that both functions construct a conjunction of clauses ‹A ❙∨ ⊥› for which it
is easy to show that we can normalize to conjunctive normal form (CNF). ›
definition encode_initial_state
:: "'variable strips_problem ⇒ sat_plan_variable formula" ("Φ⇩I _" 99)
where "encode_initial_state Π
≡ let I = initial_of Π
; vs = variables_of Π
in ❙⋀(map (λv. encode_state_variable 0 (index vs v) (I v) ❙∨ ⊥)
(filter (λv. I v ≠ None) vs))"
definition encode_goal_state
:: "'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula" ("Φ⇩G _" 99)
where "encode_goal_state Π t
≡ let
vs = variables_of Π
; G = goal_of Π
in ❙⋀(map (λv. encode_state_variable t (index vs v) (G v) ❙∨ ⊥)
(filter (λv. G v ≠ None) vs))"
text ‹ Operator preconditions are encoded using activation-implies-precondition formulation as
mentioned in \autoref{subsub:basic-sat-plan-encoding}: i.e. for each
operator \<^term>‹op ∈ 𝒪› and \<^term>‹p ∈ set (precondition_of op)› we have to encode
@{text[display, indent=4] "Atom (Operator k (index ops op)) ❙→ Atom (State k (index vs v))"}
We use the equivalent disjunction in the formalization to simplify conversion to CNF.
›
definition encode_operator_precondition
:: "'variable strips_problem
⇒ nat
⇒ 'variable strips_operator
⇒ sat_plan_variable formula"
where "encode_operator_precondition Π t op ≡ let
vs = variables_of Π
; ops = operators_of Π
in ❙⋀(map (λv.
❙¬ (Atom (Operator t (index ops op))) ❙∨ Atom (State t (index vs v)))
(precondition_of op))"
definition encode_all_operator_preconditions
:: "'variable strips_problem
⇒ 'variable strips_operator list
⇒ nat
⇒ sat_plan_variable formula"
where "encode_all_operator_preconditions Π ops t ≡ let
l = List.product [0..<t] ops
in foldr (❙∧) (map (λ(t, op). encode_operator_precondition Π t op) l) (❙¬⊥)"
text ‹ Analogously to the operator precondition, add and delete effects of operators have to be
implied by operator activation. That being said, we have to encode both positive and negative
effects and the effect must be active at the following time point: i.e.
@{text[display, indent=4] "Atom (Operator k m) ❙→ Atom (State (Suc k) n)"}
for add effects respectively
@{text[display, indent=4] "Atom (Operator k m) ❙→ ❙¬Atom (State (Suc k) n)"}
for delete effects. We again encode the implications as their equivalent disjunctions in
definition \ref{isadef:operator-effect-encoding}. ›
definition encode_operator_effect
:: "'variable strips_problem
⇒ nat
⇒ 'variable strips_operator
⇒ sat_plan_variable formula"
where "encode_operator_effect Π t op
≡ let
vs = variables_of Π
; ops = operators_of Π
in ❙⋀(map (λv.
❙¬(Atom (Operator t (index ops op)))
❙∨ Atom (State (Suc t) (index vs v)))
(add_effects_of op)
@ map (λv.
❙¬(Atom (Operator t (index ops op)))
❙∨ ❙¬ (Atom (State (Suc t) (index vs v))))
(delete_effects_of op))"
definition encode_all_operator_effects
:: "'variable strips_problem
⇒ 'variable strips_operator list
⇒ nat
⇒ sat_plan_variable formula"
where "encode_all_operator_effects Π ops t
≡ let l = List.product [0..<t] ops
in foldr (❙∧) (map (λ(t, op). encode_operator_effect Π t op) l) (❙¬⊥)"
definition encode_operators
:: "'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula"
where "encode_operators Π t
≡ let ops = operators_of Π
in encode_all_operator_preconditions Π ops t ❙∧ encode_all_operator_effects Π ops t"
text ‹
Definitions \ref{isadef:negative-transition-frame-axiom-encoding} and
\ref{isadef:positive-transition-frame-axiom-encoding} similarly encode the negative resp. positive
transition frame axioms as disjunctions. ›
definition encode_negative_transition_frame_axiom
:: "'variable strips_problem
⇒ nat
⇒ 'variable
⇒ sat_plan_variable formula"
where "encode_negative_transition_frame_axiom Π t v
≡ let vs = variables_of Π
; ops = operators_of Π
; deleting_operators = filter (λop. ListMem v (delete_effects_of op)) ops
in ❙¬(Atom (State t (index vs v)))
❙∨ (Atom (State (Suc t) (index vs v))
❙∨ ❙⋁ (map (λop. Atom (Operator t (index ops op))) deleting_operators))"
definition encode_positive_transition_frame_axiom
:: "'variable strips_problem
⇒ nat
⇒ 'variable
⇒ sat_plan_variable formula"
where "encode_positive_transition_frame_axiom Π t v
≡ let vs = variables_of Π
; ops = operators_of Π
; adding_operators = filter (λop. ListMem v (add_effects_of op)) ops
in (Atom (State t (index vs v))
❙∨ (❙¬(Atom (State (Suc t) (index vs v)))
❙∨ ❙⋁(map (λop. Atom (Operator t (index ops op))) adding_operators)))"
definition encode_all_frame_axioms
:: "'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula"
where "encode_all_frame_axioms Π t
≡ let l = List.product [0..<t] (variables_of Π)
in ❙⋀(map (λ(k, v). encode_negative_transition_frame_axiom Π k v) l
@ map (λ(k, v). encode_positive_transition_frame_axiom Π k v) l)"
text ‹ Finally, the basic SATPlan encoding is the
conjunction of the initial state, goal state, operator and frame axiom encoding for all time steps.
The functions \isaname{encode_operators} and \isaname{encode_all_frame_axioms}\footnote{Not shown.}
take care of mapping the operator precondition, effect and frame axiom encoding over all possible
combinations of time point and operators resp. time points, variables, and operators. ›
definition encode_problem ("Φ _ _" 99)
where "encode_problem Π t
≡ encode_initial_state Π
❙∧ (encode_operators Π t
❙∧ (encode_all_frame_axioms Π t
❙∧ (encode_goal_state Π t)))"
subsection "Decoding Function Definitions"
text ‹ Decoding plans from a valuation \<^term>‹𝒜› of a
SATPlan encoding entails extracting all activated operators for all
time points except the last one. We implement this by mapping over all \<^term>‹k < t›
and extracting activated operators---i.e. operators for which the model valuates the respective
operator encoding at time \<^term>‹k› to true---into a parallel operator (see definition
\ref{isadef:satplan-plan-decoding}).
\footnote{This is handled by function \texttt{decode\_plan'} (not shown).} ›
definition decode_plan'
:: "'variable strips_problem
⇒ sat_plan_variable valuation
⇒ nat
⇒ 'variable strips_operator list"
where "decode_plan' Π 𝒜 i
≡ let ops = operators_of Π
; vs = map (λop. Operator i (index ops op)) (remdups ops)
in map (λv. case v of Operator _ k ⇒ ops ! k) (filter 𝒜 vs)"
definition decode_plan
:: "'variable strips_problem
⇒ sat_plan_variable valuation
⇒ nat
⇒ 'variable strips_parallel_plan" ("Φ¯ _ _ _" 99)
where "decode_plan Π 𝒜 t ≡ map (decode_plan' Π 𝒜) [0..<t]"
text ‹ Similarly to the operator decoding, we can decode a state at time \<^term>‹k› from a valuation
of of the SATPlan encoding \<^term>‹𝒜› by constructing a map from list of assignments
\<^term>‹(v, 𝒜 (State k (index vs v)))› for all \<^term>‹v ∈ 𝒱›. ›
definition decode_state_at
:: "'variable strips_problem
⇒ sat_plan_variable valuation
⇒ nat
⇒ 'variable strips_state" ("Φ⇩S¯ _ _ _" 99)
where "decode_state_at Π 𝒜 k
≡ let
vs = variables_of Π
; state_encoding_to_assignment = λv. (v, 𝒜 (State k (index vs v)))
in map_of (map state_encoding_to_assignment vs)"
text ‹ We continue by setting up the \isaname{sat_plan} context for the proofs of soundness and
completeness. ›
definition encode_transitions ::"'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula" ("Φ⇩T _ _" 99) where
"encode_transitions Π t
≡ SAT_Plan_Base.encode_operators Π t ❙∧
SAT_Plan_Base.encode_all_frame_axioms Π t"
lemma [simp]:
"encode_transitions Π t
= SAT_Plan_Base.encode_operators Π t ❙∧
SAT_Plan_Base.encode_all_frame_axioms Π t"
unfolding encode_problem_def encode_initial_state_def encode_transitions_def
encode_goal_state_def decode_plan_def decode_state_at_def
by simp+
context
begin
lemma encode_state_variable_is_lit_plus_if:
assumes "is_valid_problem_strips Π"
and "v ∈ dom s"
shows "is_lit_plus (encode_state_variable k (index (strips_problem.variables_of Π) v) (s v))"
proof -
have "s v ≠ None"
using is_valid_problem_strips_initial_of_dom assms(2)
by blast
then consider (s_of_v_is_some_true) "s v = Some True"
| (s_of_v_is_some_false) "s v = Some False"
by fastforce
thus ?thesis
unfolding encode_state_variable_def
by (cases, simp+)
qed
lemma is_cnf_encode_initial_state:
assumes "is_valid_problem_strips Π"
shows "is_cnf (Φ⇩I Π)"
proof -
let ?I = "(Π)⇩I"
and ?vs = "strips_problem.variables_of Π"
let ?l = "map (λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥)
(filter (λv. ?I v ≠ None) ?vs)"
{
fix C
assume c_in_set_l:"C ∈ set ?l"
have "set ?l = (λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥) `
set (filter (λv. ?I v ≠ None) ?vs)"
using set_map[of "λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥"
"filter (λv. ?I v ≠ None) ?vs"]
by blast
then have "set ?l = (λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥) `
{v ∈ set ?vs. ?I v ≠ None}"
using set_filter[of "λv. ?I v ≠ None" ?vs]
by argo
then obtain v
where c_is: "C = encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥"
and v_in_set_vs: "v ∈ set ?vs"
and I_of_v_is_not_None: "?I v ≠ None"
using c_in_set_l
by auto
{
have "v ∈ dom ?I"
using I_of_v_is_not_None
by blast
moreover have "is_lit_plus (encode_state_variable 0 (index ?vs v) (?I v))"
using encode_state_variable_is_lit_plus_if[OF _ calculation] assms(1)
by blast
moreover have "is_lit_plus ⊥"
by simp
ultimately have "is_disj C"
using c_is
by force
}
hence "is_cnf C"
unfolding encode_state_variable_def
using c_is
by fastforce
}
thus ?thesis
unfolding encode_initial_state_def SAT_Plan_Base.encode_initial_state_def Let_def initial_of_def
using is_cnf_BigAnd[of ?l]
by (smt is_cnf_BigAnd)
qed
lemma encode_goal_state_is_cnf:
assumes "is_valid_problem_strips Π"
shows "is_cnf (encode_goal_state Π t)"
proof -
let ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?vs = "strips_problem.variables_of Π"
let ?l = "map (λv. encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)
(filter (λv. ?G v ≠ None) ?vs)"
{
fix C
assume "C ∈ set ?l"
moreover {
have "set ?l = (λv. encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)
` set (filter (λv. ?G v ≠ None) ?vs)"
unfolding set_map
by blast
then have "set ?l = { encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥
| v. v ∈ set ?vs ∧ ?G v ≠ None }"
by auto
}
moreover obtain v where C_is: "C = encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥ "
and "v ∈ set ?vs"
and G_of_v_is_not_None: "?G v ≠ None"
using calculation(1)
by auto
moreover {
have "v ∈ dom ?G"
using G_of_v_is_not_None
by blast
moreover have "is_lit_plus (encode_state_variable t (index ?vs v) (?G v))"
using assms(1) calculation
by (simp add: encode_state_variable_is_lit_plus_if)
moreover have "is_lit_plus ⊥"
by simp
ultimately have "is_disj C"
unfolding C_is
by force
}
ultimately have "is_cnf C"
by simp
}
thus ?thesis
unfolding encode_goal_state_def SAT_Plan_Base.encode_goal_state_def Let_def
using is_cnf_BigAnd[of ?l]
by simp
qed
private lemma encode_operator_precondition_is_cnf:
"is_cnf (encode_operator_precondition Π k op)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?l = "map (λv. ❙¬ (Atom (Operator k (index ?ops op))) ❙∨ Atom (State k (index ?vs v)))
(precondition_of op)"
{
have "set ?l = (λv. ❙¬(Atom (Operator k (index ?ops op))) ❙∨ Atom (State k (index ?vs v)))
` set (precondition_of op)"
using set_map
by force
then have "set ?l = { ❙¬(Atom (Operator k (index ?ops op))) ❙∨ Atom (State k (index ?vs v))
| v. v ∈ set (precondition_of op) }"
using setcompr_eq_image[of
"λv. ❙¬(Atom (Operator k (index ?ops op))) ❙∨ Atom (State k (index ?vs v))"
"λv. v ∈ set (precondition_of op)"]
by simp
} note set_l_is = this
{
fix C
assume "C ∈ set ?l"
then obtain v
where "v ∈ set (precondition_of op)"
and "C = ❙¬(Atom (Operator k (index ?ops op))) ❙∨ Atom (State k (index ?vs v))"
using set_l_is
by blast
hence "is_cnf C"
by simp
}
thus ?thesis
unfolding encode_operator_precondition_def
using is_cnf_BigAnd[of ?l]
by meson
qed
private lemma set_map_operator_precondition[simp]:
"set (map (λ(k, op). encode_operator_precondition Π k op) (List.product [0..<t] ops))
= { encode_operator_precondition Π k op | k op. (k, op) ∈ ({0..<t} × set ops) }"
proof -
let ?l' = "List.product [0..<t] ops"
let ?fs = "map (λ(k, op). encode_operator_precondition Π k op) ?l'"
have set_l'_is: "set ?l' = {0..<t} × set ops"
by simp
moreover {
have "set ?fs = (λ(k, op). encode_operator_precondition Π k op)
` ({0..<t} × set ops)"
using set_map set_l'_is
by simp
also have "… = { encode_operator_precondition Π k op | k op. (k, op) ∈ {0..<t} × set ops}"
using setcompr_eq_image
by fast
finally have "set ?fs = { encode_operator_precondition Π k op
| k op. (k, op) ∈ ({0..<t} × set ops) }"
by blast
}
thus ?thesis
by blast
qed
private lemma is_cnf_encode_all_operator_preconditions:
"is_cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)"
proof -
let ?l' = "List.product [0..<t] (strips_problem.operators_of Π)"
let ?fs = "map (λ(k, op). encode_operator_precondition Π k op) ?l'"
have "∀f ∈ set ?fs. is_cnf f"
using encode_operator_precondition_is_cnf
by fastforce
thus ?thesis
unfolding encode_all_operator_preconditions_def
using is_cnf_foldr_and_if[of ?fs]
by presburger
qed
private lemma set_map_or[simp]:
"set (map (λv. A v ❙∨ B v) vs) = { A v ❙∨ B v | v. v ∈ set vs }"
proof -
let ?l = "map (λv. A v ❙∨ B v) vs"
have "set ?l = (λv. A v ❙∨ B v) ` set vs"
using set_map
by force
thus ?thesis
using setcompr_eq_image
by auto
qed
private lemma encode_operator_effects_is_cnf_i:
"is_cnf (❙⋀(map (λv. (❙¬ (Atom (Operator t (index (strips_problem.operators_of Π) op))))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) (add_effects_of op)))"
proof -
let ?fs = "map (λv. ❙¬ (Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) (add_effects_of op)"
{
fix C
assume "C ∈ set ?fs"
then obtain v
where "v ∈ set (add_effects_of op)"
and "C = ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v))"
by auto
hence "is_cnf C"
by fastforce
}
thus ?thesis
using is_cnf_BigAnd
by blast
qed
private lemma encode_operator_effects_is_cnf_ii:
"is_cnf (❙⋀(map (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))) (delete_effects_of op)))"
proof -
let ?fs = "map (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))) (delete_effects_of op)"
{
fix C
assume "C ∈ set ?fs"
then obtain v
where "v ∈ set (delete_effects_of op)"
and "C = ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))"
by auto
hence "is_cnf C"
by fastforce
}
thus ?thesis
using is_cnf_BigAnd
by blast
qed
private lemma encode_operator_effect_is_cnf:
shows "is_cnf (encode_operator_effect Π t op)"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?fs = "map (λv. ❙¬(Atom (Operator t (index ?ops op)))
❙∨ Atom (State (Suc t) (index ?vs v)))
(add_effects_of op)"
and ?fs' = "map (λv. ❙¬(Atom (Operator t (index ?ops op)))
❙∨ ❙¬(Atom (State (Suc t) (index ?vs v))))
(delete_effects_of op)"
have "encode_operator_effect Π t op = ❙⋀(?fs @ ?fs')"
unfolding encode_operator_effect_def[of Π t op]
by metis
moreover {
have "∀f ∈ set ?fs. is_cnf f" "∀f ∈ set ?fs'. is_cnf f"
using encode_operator_effects_is_cnf_i[of t Π op]
encode_operator_effects_is_cnf_ii[of t Π op]
by (simp+)
hence "∀f ∈ set (?fs @ ?fs'). is_cnf f"
by auto
}
ultimately show ?thesis
using is_cnf_BigAnd[of "?fs @ ?fs'"]
by presburger
qed
private lemma set_map_encode_operator_effect[simp]:
"set (map (λ(t, op). encode_operator_effect Π t op) (List.product [0..<t]
(strips_problem.operators_of Π)))
= { encode_operator_effect Π k op
| k op. (k, op) ∈ ({0..<t} × set (strips_problem.operators_of Π)) }"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?fs = "map (λ(t, op). encode_operator_effect Π t op) (List.product [0..<t] ?ops)"
have "set ?fs = (λ(t, op). encode_operator_effect Π t op) ` ({0..<t} × set ?ops)"
unfolding encode_operator_effect_def[of Π t]
by force
thus ?thesis
using setcompr_eq_image[of "λ(t, op). encode_operator_effect Π t op"
"λ(k, op). (k, op) ∈ {0..<t} × set ?ops"]
by force
qed
private lemma encode_all_operator_effects_is_cnf:
assumes "is_valid_problem_strips Π"
shows "is_cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?l = "List.product [0..<t] ?ops"
let ?fs = "map (λ(t, op). encode_operator_effect Π t op) ?l"
have "∀f ∈ set ?fs. is_cnf f"
using encode_operator_effect_is_cnf
by force
thus ?thesis
unfolding encode_all_operator_effects_def
using is_cnf_foldr_and_if[of ?fs]
by presburger
qed
lemma encode_operators_is_cnf:
assumes "is_valid_problem_strips Π"
shows "is_cnf (encode_operators Π t)"
unfolding encode_operators_def
using is_cnf_encode_all_operator_preconditions[of Π t]
encode_all_operator_effects_is_cnf[OF assms, of t]
is_cnf.simps(1)[of "encode_all_operator_preconditions Π (strips_problem.operators_of Π) t"
"encode_all_operator_effects Π (strips_problem.operators_of Π) t"]
by meson
private lemma set_map_to_operator_atom[simp]:
"set (map (λop. Atom (Operator t (index (strips_problem.operators_of Π) op)))
(filter (λop. ListMem v vs) (strips_problem.operators_of Π)))
= { Atom (Operator t (index (strips_problem.operators_of Π) op))
| op. op ∈ set (strips_problem.operators_of Π) ∧ v ∈ set vs }"
proof -
let ?ops = "strips_problem.operators_of Π"
{
have "set (filter (λop. ListMem v vs) ?ops)
= { op ∈ set ?ops. ListMem v vs }"
using set_filter
by force
then have "set (filter (λop. ListMem v vs) ?ops)
= { op. op ∈ set ?ops ∧ v ∈ set vs }"
using ListMem_iff[of v]
by blast
}
then have "set (map (λop. Atom (Operator t (index ?ops op)))
(filter (λop. ListMem v vs) ?ops))
= (λop. Atom (Operator t (index ?ops op))) ` { op ∈ set ?ops. v ∈ set vs }"
using set_map[of "λop. Atom (Operator t (index ?ops op))"]
by presburger
thus ?thesis
by blast
qed
lemma is_disj_big_or_if:
assumes "∀f ∈ set fs. is_lit_plus f"
shows "is_disj ❙⋁fs"
using assms
proof (induction fs)
case (Cons f fs)
have "is_lit_plus f"
using Cons.prems
by simp
moreover have "is_disj ❙⋁fs"
using Cons
by fastforce
ultimately show ?case
by simp
qed simp
lemma is_cnf_encode_negative_transition_frame_axiom:
shows "is_cnf (encode_negative_transition_frame_axiom Π t v)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?deleting = "filter (λop. ListMem v (delete_effects_of op)) ?ops"
let ?fs = "map (λop. Atom (Operator t (index ?ops op))) ?deleting"
and ?A = "(❙¬(Atom (State t (index ?vs v))))"
and ?B = "Atom (State (Suc t) (index ?vs v))"
{
fix f
assume "f ∈ set ?fs"
then obtain op
where "op ∈ set ?ops"
and "v ∈ set (delete_effects_of op)"
and "f = Atom (Operator t (index ?ops op))"
using set_map_to_operator_atom[of t Π v]
by fastforce
hence "is_lit_plus f"
by simp
} note nb = this
{
have "is_disj ❙⋁?fs"
using is_disj_big_or_if nb
by blast
then have "is_disj (?B ❙∨ ❙⋁?fs)"
by force
then have "is_disj (?A ❙∨ (?B ❙∨ ❙⋁?fs))"
by fastforce
hence "is_cnf (?A ❙∨ (?B ❙∨ ❙⋁?fs))"
by fastforce
}
thus ?thesis
unfolding encode_negative_transition_frame_axiom_def
by meson
qed
lemma is_cnf_encode_positive_transition_frame_axiom:
shows "is_cnf (encode_positive_transition_frame_axiom Π t v)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?adding = "filter (λop. ListMem v (add_effects_of op)) ?ops"
let ?fs = "map (λop. Atom (Operator t (index ?ops op))) ?adding"
and ?A = "Atom (State t (index ?vs v))"
and ?B = "❙¬(Atom (State (Suc t) (index ?vs v)))"
{
fix f
assume "f ∈ set ?fs"
then obtain op
where "op ∈ set ?ops"
and "v ∈ set (add_effects_of op)"
and "f = Atom (Operator t (index ?ops op))"
using set_map_to_operator_atom[of t Π v]
by fastforce
hence "is_lit_plus f"
by simp
} note nb = this
{
have "is_disj ❙⋁?fs"
using is_disj_big_or_if nb
by blast
then have "is_disj (?B ❙∨ ❙⋁?fs)"
by force
then have "is_disj (?A ❙∨ (?B ❙∨ ❙⋁?fs))"
by fastforce
hence "is_cnf (?A ❙∨ (?B ❙∨ ❙⋁?fs))"
by fastforce
}
thus ?thesis
unfolding encode_positive_transition_frame_axiom_def
by meson
qed
private lemma encode_all_frame_axioms_set[simp]:
"set (map (λ(k, v). encode_negative_transition_frame_axiom Π k v)
(List.product [0..<t] (strips_problem.variables_of Π))
@ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v)
(List.product [0..<t] (strips_problem.variables_of Π))))
= { encode_negative_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set (strips_problem.variables_of Π)) }
∪ { encode_positive_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set (strips_problem.variables_of Π)) }"
proof -
let ?l = "List.product [0..<t] (strips_problem.variables_of Π)"
let ?A = "(λ(k, v). encode_negative_transition_frame_axiom Π k v) ` set ?l"
and ?B = "(λ(k, v). encode_positive_transition_frame_axiom Π k v) ` set ?l"
and ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
@ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l)"
and ?vs = "strips_problem.variables_of Π"
have set_l_is: "set ?l = {0..<t} × set ?vs"
by simp
have "set ?fs = ?A ∪ ?B"
using set_append
by force
moreover have "?A = { encode_negative_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ?vs) }"
using set_l_is setcompr_eq_image[of "λ(k, v). encode_negative_transition_frame_axiom Π k v"
"λ(k, v). (k, v) ∈ ({0..<t} × set ?vs)"]
by fast
moreover have "?B = { encode_positive_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ?vs) }"
using set_l_is setcompr_eq_image[of "λ(k, v). encode_positive_transition_frame_axiom Π k v"
"λ(k, v). (k, v) ∈ ({0..<t} × set ?vs)"]
by fast
ultimately show ?thesis
by argo
qed
lemma encode_frame_axioms_is_cnf:
shows "is_cnf (encode_all_frame_axioms Π t)"
proof -
let ?l = "List.product [0..<t] (strips_problem.variables_of Π)"
and ?vs = "strips_problem.variables_of Π"
let ?A = "{ encode_negative_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ?vs) }"
and ?B = "{ encode_positive_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ?vs) }"
and ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
@ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l)"
{
fix f
assume "f ∈ set ?fs"
then consider (f_encodes_negative_frame_axiom) "f ∈ ?A"
| (f_encodes_positive_frame_axiom) "f ∈ ?B"
by fastforce
hence "is_cnf f"
using is_cnf_encode_negative_transition_frame_axiom
is_cnf_encode_positive_transition_frame_axiom
by (smt mem_Collect_eq)
}
thus ?thesis
unfolding encode_all_frame_axioms_def
using is_cnf_BigAnd[of ?fs]
by meson
qed
lemma is_cnf_encode_problem:
assumes "is_valid_problem_strips Π"
shows "is_cnf (Φ Π t)"
proof -
have "is_cnf (Φ⇩I Π)"
using is_cnf_encode_initial_state assms
by auto
moreover have "is_cnf (encode_goal_state Π t)"
using encode_goal_state_is_cnf[OF assms]
by simp
moreover have "is_cnf (encode_operators Π t ❙∧ encode_all_frame_axioms Π t)"
using encode_operators_is_cnf[OF assms] encode_frame_axioms_is_cnf
unfolding encode_transitions_def
by simp
ultimately show ?thesis
unfolding encode_problem_def SAT_Plan_Base.encode_problem_def
encode_transitions_def encode_initial_state_def[symmetric] encode_goal_state_def[symmetric]
by simp
qed
lemma encode_problem_has_model_then_also_partial_encodings:
assumes "𝒜 ⊨ SAT_Plan_Base.encode_problem Π t"
shows "𝒜 ⊨ SAT_Plan_Base.encode_initial_state Π"
and "𝒜 ⊨ SAT_Plan_Base.encode_goal_state Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_operators Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_all_frame_axioms Π t"
using assms
unfolding SAT_Plan_Base.encode_problem_def
by simp+
lemma cnf_of_encode_problem_structure:
shows "cnf (SAT_Plan_Base.encode_initial_state Π)
⊆ cnf (SAT_Plan_Base.encode_problem Π t)"
and "cnf (SAT_Plan_Base.encode_goal_state Π t)
⊆ cnf (SAT_Plan_Base.encode_problem Π t)"
and "cnf (SAT_Plan_Base.encode_operators Π t)
⊆ cnf (SAT_Plan_Base.encode_problem Π t)"
and "cnf (SAT_Plan_Base.encode_all_frame_axioms Π t)
⊆ cnf (SAT_Plan_Base.encode_problem Π t)"
unfolding SAT_Plan_Base.encode_problem_def
SAT_Plan_Base.encode_problem_def[of Π t] SAT_Plan_Base.encode_initial_state_def[of Π]
SAT_Plan_Base.encode_goal_state_def[of Π t] SAT_Plan_Base.encode_operators_def
SAT_Plan_Base.encode_all_frame_axioms_def[of Π t]
subgoal by auto
subgoal by force
subgoal by auto
subgoal by force
done
private lemma cnf_of_encode_initial_state_set_i:
shows "cnf (Φ⇩I Π) = ⋃ { cnf (encode_state_variable 0
(index (strips_problem.variables_of Π) v) (((Π)⇩I) v))
| v. v ∈ set (strips_problem.variables_of Π) ∧ ((Π)⇩I) v ≠ None }"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?I = "strips_problem.initial_of Π"
let ?ls = "map (λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥)
(filter (λv. ?I v ≠ None) ?vs)"
{
have "cnf ` set ?ls = cnf ` (λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥)
` set (filter (λv. ?I v ≠ None) ?vs)"
using set_map[of "λv. encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥"]
by presburger
also have "… = (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v) ❙∨ ⊥))
` set (filter (λv. ?I v ≠ None) ?vs)"
using image_comp
by blast
also have "… = (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v)))
` { v ∈ set ?vs. ?I v ≠ None }"
using set_filter[of "λv. ?I v ≠ None" ?vs]
by auto
finally have "cnf ` set ?ls = { cnf (encode_state_variable 0 (index ?vs v) (?I v))
| v. v ∈ set ?vs ∧ ?I v ≠ None }"
using setcompr_eq_image[of "λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))"]
by presburger
}
moreover have "cnf (Φ⇩I Π) = ⋃ (cnf ` set ?ls)"
unfolding encode_initial_state_def SAT_Plan_Base.encode_initial_state_def
using cnf_BigAnd[of ?ls]
by meson
ultimately show ?thesis
by auto
qed
corollary cnf_of_encode_initial_state_set_ii:
assumes "is_valid_problem_strips Π"
shows "cnf (Φ⇩I Π) = (⋃v ∈ set (strips_problem.variables_of Π). {{
literal_formula_to_literal (encode_state_variable 0 (index (strips_problem.variables_of Π) v)
(strips_problem.initial_of Π v)) }})"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?I = "strips_problem.initial_of Π"
have nb⇩1: "{ v. v ∈ set ?vs ∧ ?I v ≠ None } = set ?vs"
using is_valid_problem_strips_initial_of_dom assms(1)
by auto
{
fix v
assume "v ∈ set ?vs"
then have "?I v ≠ None"
using is_valid_problem_strips_initial_of_dom assms(1)
by auto
then consider (I_v_is_Some_True) "?I v = Some True"
| (I_v_is_Some_False) "?I v = Some False"
by fastforce
hence "cnf (encode_state_variable 0 (index ?vs v) (?I v))
= {{ literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }}"
unfolding encode_state_variable_def
by (cases, simp+)
} note nb⇩2 = this
{
have "{ cnf (encode_state_variable 0 (index ?vs v) (?I v)) | v. v ∈ set ?vs ∧ ?I v ≠ None }
= (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))) ` set ?vs"
using setcompr_eq_image[of "λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))"
"λv. v ∈ set ?vs ∧ ?I v ≠ None"] using nb⇩1
by presburger
hence "{ cnf (encode_state_variable 0 (index ?vs v) (?I v)) | v. v ∈ set ?vs ∧ ?I v ≠ None }
= (λv. {{ literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }})
` set ?vs"
using nb⇩2
by force
}
thus ?thesis
using cnf_of_encode_initial_state_set_i
by (smt Collect_cong)
qed
lemma cnf_of_encode_initial_state_set:
assumes "is_valid_problem_strips Π"
and "v ∈ dom (strips_problem.initial_of Π)"
shows "strips_problem.initial_of Π v = Some True ⟶ (∃!C. C ∈ cnf (Φ⇩I Π)
∧ C = { (State 0 (index (strips_problem.variables_of Π) v))⇧+ })"
and "strips_problem.initial_of Π v = Some False ⟶ (∃!C. C ∈ cnf (Φ⇩I Π)
∧ C = { (State 0 (index (strips_problem.variables_of Π) v))¯ })"
proof -
let ?I = "(Π)⇩I"
let ?vs = "strips_problem.variables_of Π"
let ?Φ⇩I = "Φ⇩I Π"
have nb⇩1: "cnf (Φ⇩I Π) = ⋃ { cnf (encode_state_variable 0 (index ?vs v)
(strips_problem.initial_of Π v)) | v. v ∈ set ?vs ∧ ?I v ≠ None }"
using cnf_of_encode_initial_state_set_i
by blast
{
have "v ∈ set ?vs"
using is_valid_problem_strips_initial_of_dom assms(1, 2)
by blast
hence "v ∈ { v. v ∈ set ?vs ∧ ?I v ≠ None }"
using assms(2)
by auto
} note nb⇩2 = this
show "strips_problem.initial_of Π v = Some True ⟶ (∃!C. C ∈ cnf (Φ⇩I Π)
∧ C = { (State 0 (index (strips_problem.variables_of Π) v))⇧+ })"
and "strips_problem.initial_of Π v = Some False ⟶ (∃!C. C ∈ cnf (Φ⇩I Π)
∧ C = { (State 0 (index (strips_problem.variables_of Π) v))¯ })"
proof (auto)
assume i_v_is_some_true: "strips_problem.initial_of Π v = Some True"
then have "{ (State 0 (index (strips_problem.variables_of Π) v))⇧+ }
∈ cnf (encode_state_variable 0 (index (strips_problem.variables_of Π) v) (?I v))"
unfolding encode_state_variable_def
using i_v_is_some_true
by auto
thus "{ (State 0 (index (strips_problem.variables_of Π) v))⇧+ }
∈ cnf (Φ⇩I Π)"
using nb⇩1 nb⇩2
by auto
next
assume i_v_is_some_false: "strips_problem.initial_of Π v = Some False"
then have "{ (State 0 (index (strips_problem.variables_of Π) v))¯ }
∈ cnf (encode_state_variable 0 (index (strips_problem.variables_of Π) v) (?I v))"
unfolding encode_state_variable_def
using i_v_is_some_false
by auto
thus "{ (State 0 (index (strips_problem.variables_of Π) v))¯ }
∈ cnf (Φ⇩I Π)"
using nb⇩1 nb⇩2
by auto
qed
qed
lemma cnf_of_operator_encoding_structure:
"cnf (encode_operators Π t) = cnf (encode_all_operator_preconditions Π
(strips_problem.operators_of Π) t)
∪ cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
unfolding encode_operators_def
using cnf.simps(5)
by metis
corollary cnf_of_operator_precondition_encoding_subset_encoding:
"cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)
⊆ cnf (Φ Π t)"
using cnf_of_operator_encoding_structure cnf_of_encode_problem_structure subset_trans
unfolding encode_problem_def
by blast
lemma cnf_foldr_and[simp]:
"cnf (foldr (❙∧) fs (❙¬⊥)) = (⋃f ∈ set fs. cnf f)"
proof (induction fs)
case (Cons f fs)
have ih: "cnf (foldr (❙∧) fs (❙¬⊥)) = (⋃f ∈ set fs. cnf f)"
using Cons.IH
by blast
{
have "cnf (foldr (❙∧) (f # fs) (❙¬⊥)) = cnf (f ❙∧ foldr (❙∧) fs (❙¬⊥))"
by simp
also have "… = cnf f ∪ cnf (foldr (❙∧) fs (❙¬⊥))"
by force
finally have "cnf (foldr (❙∧) (f # fs) (❙¬⊥)) = cnf f ∪ (⋃f ∈ set fs. cnf f)"
using ih
by argo
}
thus ?case
by auto
qed simp
private lemma cnf_of_encode_operator_precondition[simp]:
"cnf (encode_operator_precondition Π t op) = (⋃v ∈ set (precondition_of op).
{{(Operator t (index (strips_problem.operators_of Π) op))¯
, (State t (index (strips_problem.variables_of Π) v))⇧+}})"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?Φ⇩P = "encode_operator_precondition Π t op"
let ?fs = "map (λv. ❙¬ (Atom (Operator t (index ?ops op))) ❙∨ Atom (State t (index ?vs v)))
(precondition_of op)"
and ?A = "(λv. ❙¬ (Atom (Operator t (index ?ops op))) ❙∨ Atom (State t (index ?vs v)))
` set (precondition_of op)"
have "cnf (encode_operator_precondition Π t op) = cnf (❙⋀?fs)"
unfolding encode_operator_precondition_def
by presburger
also have "… = ⋃ (cnf ` set ?fs)"
using cnf_BigAnd
by blast
also have "… = ⋃(cnf ` ?A)"
using set_map[of "λv. ❙¬ (Atom (Operator t (index ?ops op))) ❙∨ Atom (State t (index ?vs v))"
"precondition_of op"]
by argo
also have "… = (⋃v ∈ set (precondition_of op).
cnf (❙¬(Atom (Operator t (index ?ops op))) ❙∨ Atom (State t (index ?vs v))))"
by blast
finally show ?thesis
by auto
qed
lemma cnf_of_encode_all_operator_preconditions_structure[simp]:
"cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)
= (⋃(t, op) ∈ ({..<t} × set (operators_of Π)).
(⋃v ∈ set (precondition_of op).
{{(Operator t (index (strips_problem.operators_of Π) op))¯
, (State t (index (strips_problem.variables_of Π) v))⇧+}}))"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?l = "List.product [0..<t] ?ops"
and ?Φ⇩P = "encode_all_operator_preconditions Π (strips_problem.operators_of Π) t"
let ?A = "set (map (λ(t, op). encode_operator_precondition Π t op) ?l)"
{
have "set ?l = {0..<t} × set ((Π)⇩𝒪)"
by auto
then have "?A = (λ(t, op). encode_operator_precondition Π t op) ` ({0..<t} × set ((Π)⇩𝒪))"
using set_map
by force
} note nb = this
have "cnf ?Φ⇩P = cnf (foldr (❙∧) (map (λ(t, op). encode_operator_precondition Π t op) ?l) (❙¬⊥))"
unfolding encode_all_operator_preconditions_def
by presburger
also have "… = (⋃f ∈ ?A. cnf f)"
by simp
also have "… = (⋃(k, op) ∈ ({0..<t} × set ((Π)⇩𝒪)).
cnf (encode_operator_precondition Π k op))"
using nb
by fastforce
finally show ?thesis
by fastforce
qed
corollary cnf_of_encode_all_operator_preconditions_contains_clause_if:
fixes Π::"'variable STRIPS_Representation.strips_problem"
assumes "is_valid_problem_strips (Π::'variable STRIPS_Representation.strips_problem)"
and "k < t"
and "op ∈ set ((Π)⇩𝒪)"
and "v ∈ set (precondition_of op)"
shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State k (index (strips_problem.variables_of Π) v))⇧+ }
∈ cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Φ⇩P = "encode_all_operator_preconditions Π ?ops t"
and ?C = "{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State k (index (strips_problem.variables_of Π) v))⇧+ }"
{
have nb: "(k, op) ∈ {..<t} × set ((Π)⇩𝒪)"
using assms(2, 3)
by blast
moreover {
have "?C ∈ (⋃v∈set (precondition_of op).
{{(Operator k (index (strips_problem.operators_of Π) op))¯,
(State k (index (strips_problem.variables_of Π) v))⇧+}})"
using UN_iff[where A="set (precondition_of op)"
and B="λv. {{(Operator t (index (strips_problem.operators_of Π) op))¯,
(State t (index (strips_problem.variables_of Π) v))⇧+}}"] assms(4)
by blast
hence "∃x∈{..<t} × set ((Π)⇩𝒪).
?C ∈ (case x of (k, op) ⇒ ⋃v∈set (precondition_of op).
{{(Operator k (index (strips_problem.operators_of Π) op))¯,
(State k (index (strips_problem.variables_of Π) v))⇧+}})"
using nb
by blast
}
ultimately have "?C ∈ (⋃(t, op) ∈ ({..<t} × set ((Π)⇩𝒪)).
(⋃v ∈ set (precondition_of op).
{{ (Operator t (index ?ops op))¯, (State t (index ?vs v))⇧+ }}))"
by blast
}
thus ?thesis
using cnf_of_encode_all_operator_preconditions_structure[of Π t]
by argo
qed
corollary cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem:
"cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)
⊆ cnf (Φ Π t)"
using cnf_of_encode_problem_structure(3) cnf_of_operator_encoding_structure
unfolding encode_problem_def
by blast
private lemma cnf_of_encode_operator_effect_structure[simp]:
"cnf (encode_operator_effect Π t op)
= (⋃v ∈ set (add_effects_of op). {{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))⇧+ }})
∪ (⋃v ∈ set (delete_effects_of op).
{{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})"
proof -
let ?fs⇩1 = "map (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))
(add_effects_of op)"
and ?fs⇩2 = "map (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬ (Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
(delete_effects_of op)"
{
have "cnf ` set ?fs⇩1 = cnf
` (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) ` set (add_effects_of op)"
using set_map
by force
also have "… = (λv. cnf (❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
` set (add_effects_of op)"
using image_comp
by blast
finally have "cnf ` set ?fs⇩1 = (λv. {{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))⇧+ }}) ` set (add_effects_of op)"
by auto
} note nb⇩1 = this
{
have "cnf ` set ?fs⇩2 = cnf ` (λv. ❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
` set (delete_effects_of op)"
using set_map
by force
also have "… = (λv. cnf (❙¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
❙∨ ❙¬ (Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))))
` set (delete_effects_of op)"
using image_comp
by blast
finally have "cnf ` set ?fs⇩2 = (λv. {{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})
` set (delete_effects_of op)"
by auto
} note nb⇩2 = this
{
have "cnf (encode_operator_effect Π t op) = ⋃(cnf ` set (?fs⇩1 @ ?fs⇩2))"
unfolding encode_operator_effect_def
using cnf_BigAnd[of "?fs⇩1 @ ?fs⇩2"]
by meson
also have "… = ⋃(cnf ` set ?fs⇩1 ∪ cnf ` set ?fs⇩2)"
using set_append[of "?fs⇩1" "?fs⇩2"] image_Un[of cnf "set ?fs⇩1" "set ?fs⇩2"]
by argo
also have "… = ⋃(cnf ` set ?fs⇩1) ∪ ⋃(cnf ` set ?fs⇩2)"
using Union_Un_distrib[of "cnf ` set ?fs⇩1" "cnf ` set ?fs⇩2"]
by argo
finally have "cnf (encode_operator_effect Π t op)
= (⋃v ∈ set (add_effects_of op).
{{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))⇧+ }})
∪ (⋃v ∈ set (delete_effects_of op).
{{ (Operator t (index (strips_problem.operators_of Π) op))¯
, (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})"
using nb⇩1 nb⇩2
by argo
}
thus ?thesis
by blast
qed
lemma cnf_of_encode_all_operator_effects_structure:
"cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)
= (⋃(k, op) ∈ ({0..<t} × set ((Π)⇩𝒪)).
(⋃v ∈ set (add_effects_of op).
{{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }}))
∪ (⋃(k, op) ∈ ({0..<t} × set ((Π)⇩𝒪)).
(⋃v ∈ set (delete_effects_of op).
{{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}))"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Φ⇩E = "encode_all_operator_effects Π ?ops t"
and ?l = "List.product [0..<t] ?ops"
let ?fs = "map (λ(t, op). encode_operator_effect Π t op) ?l"
have nb: "set (List.product [0..<t] ?ops) = {0..<t} × set ?ops"
by simp
{
have "cnf ` set ?fs = cnf ` (λ(k, op). encode_operator_effect Π k op) ` ({0..<t} × set ?ops)"
by force
also have "… = (λ(k, op). cnf (encode_operator_effect Π k op)) ` ({0..<t} × set ?ops)"
using image_comp
by fast
finally have "cnf ` set ?fs = (λ(k, op).
(⋃v ∈ set (add_effects_of op).
{{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }})
∪ (⋃v ∈ set (delete_effects_of op).
{{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}))
` ({0..<t} × set ?ops)"
using cnf_of_encode_operator_effect_structure
by auto
}
thus ?thesis
unfolding encode_all_operator_effects_def
using cnf_BigAnd[of ?fs]
by auto
qed
corollary cnf_of_operator_effect_encoding_contains_add_effect_clause_if:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "k < t"
and "op ∈ set ((Π)⇩𝒪)"
and "v ∈ set (add_effects_of op)"
shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }
∈ cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
let ?Φ⇩E = "encode_all_operator_effects Π (strips_problem.operators_of Π) t"
and ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Add = "⋃(k, op)∈{0..<t} × set ((Π)⇩𝒪).
⋃v∈set (add_effects_of op). {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}}"
let ?C = "{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+ }"
have "?Add ⊆ cnf ?Φ⇩E"
using cnf_of_encode_all_operator_effects_structure[of Π t] Un_upper1[of "?Add"]
by presburger
moreover {
have "?C ∈ {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+ }}"
using assms(4)
by blast
then have "?C ∈ (⋃v∈set (add_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}})"
using Complete_Lattices.UN_iff[of "?C" "λv. {{ (Operator k (index ?ops op))¯
, (State (Suc k) (index ?vs v))⇧+}}" "set (add_effects_of op)"]
using assms(4)
by blast
moreover have "(k, op) ∈ ({0..<t} × set ((Π)⇩𝒪))"
using assms(2, 3)
by fastforce
ultimately have "?C ∈ ?Add"
by blast
}
ultimately show ?thesis
using subset_eq[of "?Add" "cnf ?Φ⇩E"]
by meson
qed
corollary cnf_of_operator_effect_encoding_contains_delete_effect_clause_if:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "k < t"
and "op ∈ set ((Π)⇩𝒪)"
and "v ∈ set (delete_effects_of op)"
shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
∈ cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
let ?Φ⇩E = "encode_all_operator_effects Π (strips_problem.operators_of Π) t"
and ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Delete = "(⋃(k, op)∈{0..<t} × set ((Π)⇩𝒪).
⋃v∈set (delete_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
let ?C = "{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }"
have "?Delete ⊆ cnf ?Φ⇩E"
using cnf_of_encode_all_operator_effects_structure[of Π t] Un_upper2[of "?Delete"]
by presburger
moreover {
have "?C ∈ (⋃v ∈ set (delete_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
using assms(4)
by blast
moreover have "(k, op) ∈ {0..<t} × set ?ops"
using assms(2, 3)
by force
ultimately have "?C ∈ ?Delete"
by fastforce
}
ultimately show ?thesis
using subset_eq[of "?Delete" "cnf ?Φ⇩E"]
by meson
qed
private lemma cnf_of_big_or_of_literal_formulas_is[simp]:
assumes "∀f ∈ set fs. is_literal_formula f"
shows "cnf (❙⋁fs) = {{ literal_formula_to_literal f | f. f ∈ set fs }}"
using assms
proof (induction fs)
case (Cons f fs)
{
have is_literal_formula_f: "is_literal_formula f"
using Cons.prems(1)
by simp
then have "cnf f = {{ literal_formula_to_literal f }}"
using cnf_of_literal_formula
by blast
} note nb⇩1 = this
{
have "∀f' ∈ set fs. is_literal_formula f'"
using Cons.prems
by fastforce
hence "cnf (❙⋁fs) = {{ literal_formula_to_literal f | f. f ∈ set fs }}"
using Cons.IH
by argo
} note nb⇩2 = this
{
have "cnf (❙⋁(f # fs)) = (λ(g, h). g ∪ h)
` ({{ literal_formula_to_literal f}}
× {{ literal_formula_to_literal f' | f'. f' ∈ set fs }})"
using nb⇩1 nb⇩2
by simp
also have "… = {{ literal_formula_to_literal f}
∪ { literal_formula_to_literal f' | f'. f' ∈ set fs }}"
by fast
finally have "cnf (❙⋁(f # fs)) = {{ literal_formula_to_literal f' | f'. f' ∈ set (f # fs) }}"
by fastforce
}
thus ?case .
qed simp
private lemma set_filter_op_list_mem_vs[simp]:
"set (filter (λop. ListMem v vs) ops) = { op. op ∈ set ops ∧ v ∈ set vs }"
using set_filter[of "λop. ListMem v vs" ops] ListMem_iff
by force
private lemma cnf_of_positive_transition_frame_axiom:
"cnf (encode_positive_transition_frame_axiom Π k v)
= {{ (State k (index (strips_problem.variables_of Π) v))⇧+
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
∪ { (Operator k (index (strips_problem.operators_of Π) op))⇧+
| op. op ∈ set (strips_problem.operators_of Π) ∧ v ∈ set (add_effects_of op) }}"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?adding_operators = "filter (λop. ListMem v (add_effects_of op)) ?ops"
let ?fs = "map (λop. Atom (Operator k (index ?ops op))) ?adding_operators"
{
have "set ?fs = (λop. Atom (Operator k (index ?ops op))) ` set ?adding_operators"
using set_map[of "λop. Atom (Operator k (index ?ops op))" "?adding_operators"]
by blast
then have "literal_formula_to_literal ` set ?fs
= (λop. (Operator k (index ?ops op))⇧+) ` set ?adding_operators"
using image_comp[of literal_formula_to_literal "λop. Atom (Operator k (index ?ops op))"
"set ?adding_operators"]
by simp
also have "… = (λop. (Operator k (index ?ops op))⇧+)
` { op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
using set_filter_op_list_mem_vs[of v _ ?ops]
by auto
finally have "literal_formula_to_literal ` set ?fs
= { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
using setcompr_eq_image[of "λop. (Operator k (index ?ops op))⇧+"
"λop. op ∈set ?adding_operators"]
by blast
hence "cnf (❙⋁?fs) = {{ (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}"
using cnf_of_big_or_of_literal_formulas_is[of ?fs]
setcompr_eq_image[of literal_formula_to_literal "λf. f ∈ set ?fs"]
by force
}
then have "cnf (❙¬(Atom (State (Suc k) (index ?vs v))) ❙∨ ❙⋁?fs)
= {{ (State (Suc k) (index ?vs v))¯ } ∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}"
by force
then have "cnf ((Atom (State k (index ?vs v)) ❙∨ (❙¬(Atom (State (Suc k) (index ?vs v))) ❙∨ ❙⋁?fs)))
= {{ (State k (index ?vs v))⇧+ }
∪ { (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}"
by simp
moreover have "cnf (encode_positive_transition_frame_axiom Π k v)
= cnf ((Atom (State k (index ?vs v)) ❙∨ (❙¬(Atom (State (Suc k) (index ?vs v))) ❙∨ ❙⋁?fs)))"
unfolding encode_positive_transition_frame_axiom_def
by metis
ultimately show ?thesis
by blast
qed
private lemma cnf_of_negative_transition_frame_axiom:
"cnf (encode_negative_transition_frame_axiom Π k v)
= {{ (State k (index (strips_problem.variables_of Π) v))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }
∪ { (Operator k (index (strips_problem.operators_of Π) op))⇧+
| op. op ∈ set (strips_problem.operators_of Π) ∧ v ∈ set (delete_effects_of op) }}"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?deleting_operators = "filter (λop. ListMem v (delete_effects_of op)) ?ops"
let ?fs = "map (λop. Atom (Operator k (index ?ops op))) ?deleting_operators"
{
have "set ?fs = (λop. Atom (Operator k (index ?ops op))) ` set ?deleting_operators"
using set_map[of "λop. Atom (Operator k (index ?ops op))" "?deleting_operators"]
by blast
then have "literal_formula_to_literal ` set ?fs
= (λop. (Operator k (index ?ops op))⇧+) ` set ?deleting_operators"
using image_comp[of literal_formula_to_literal "λop. Atom (Operator k (index ?ops op))"
"set ?deleting_operators"]
by simp
also have "… = (λop. (Operator k (index ?ops op))⇧+)
` { op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
using set_filter_op_list_mem_vs[of v _ ?ops]
by auto
finally have "literal_formula_to_literal ` set ?fs
= { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
using setcompr_eq_image[of "λop. (Operator k (index ?ops op))⇧+"
"λop. op ∈set ?deleting_operators"]
by blast
hence "cnf (❙⋁?fs) = {{ (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }}"
using cnf_of_big_or_of_literal_formulas_is[of ?fs]
setcompr_eq_image[of literal_formula_to_literal "λf. f ∈ set ?fs"]
by force
}
then have "cnf (Atom (State (Suc k) (index ?vs v)) ❙∨ ❙⋁?fs)
= {{ (State (Suc k) (index ?vs v))⇧+ } ∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }}"
by force
then have "cnf ((❙¬(Atom (State k (index ?vs v))) ❙∨ (Atom (State (Suc k) (index ?vs v)) ❙∨ ❙⋁?fs)))
= {{ (State k (index ?vs v))¯ }
∪ { (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }}"
by simp
moreover have "cnf (encode_negative_transition_frame_axiom Π k v)
= cnf ((❙¬(Atom (State k (index ?vs v))) ❙∨ (Atom (State (Suc k) (index ?vs v)) ❙∨ ❙⋁?fs)))"
unfolding encode_negative_transition_frame_axiom_def
by metis
ultimately show ?thesis
by blast
qed
lemma cnf_of_encode_all_frame_axioms_structure:
"cnf (encode_all_frame_axioms Π t)
= ⋃(⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index (strips_problem.variables_of Π) v))⇧+
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
∪ {(Operator k (index (strips_problem.operators_of Π) op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})
∪ ⋃(⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index (strips_problem.variables_of Π) v))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }
∪ { (Operator k (index (strips_problem.operators_of Π) op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }}})"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?Φ⇩F = "encode_all_frame_axioms Π t"
let ?l = "List.product [0..<t] ?vs"
let ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
@ map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l"
{
let ?A = "{ encode_negative_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)) }"
and ?B = "{ encode_positive_transition_frame_axiom Π k v
| k v. (k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)) }"
have set_l: "set ?l = {..<t} × set ((Π)⇩𝒱)"
using set_product
by force
have "set ?fs = ?A ∪ ?B"
unfolding set_append set_map
using encode_all_frame_axioms_set
by force
then have "cnf ` set ?fs = cnf ` ?A ∪ cnf ` ?B"
using image_Un[of cnf "?A" "?B"]
by argo
moreover {
have "?A = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{ encode_negative_transition_frame_axiom Π k v })"
by blast
then have "cnf ` ?A = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{ cnf (encode_negative_transition_frame_axiom Π k v) })"
by blast
hence "cnf ` ?A = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))¯
, (State (Suc k) (index ?vs v))⇧+ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op)}}})"
using cnf_of_negative_transition_frame_axiom[of Π]
by presburger
}
moreover {
have "?B = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{ encode_positive_transition_frame_axiom Π k v})"
by blast
then have "cnf ` ?B = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{ cnf (encode_positive_transition_frame_axiom Π k v) })"
by blast
hence "cnf ` ?B = (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))⇧+
, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}})"
using cnf_of_positive_transition_frame_axiom[of Π]
by presburger
}
ultimately have "cnf ` set ?fs
= (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))⇧+
, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})
∪ (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))¯
, (State (Suc k) (index ?vs v))⇧+ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op)}}})"
unfolding set_append set_map
by force
}
then have "cnf (encode_all_frame_axioms Π t)
= ⋃((⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))⇧+
, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})
∪ (⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))¯
, (State (Suc k) (index ?vs v))⇧+ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op)}}}))"
unfolding encode_all_frame_axioms_def Let_def
using cnf_BigAnd[of ?fs]
by argo
thus ?thesis
using Union_Un_distrib[of
"(⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))⇧+
, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})"
"(⋃(k, v) ∈ ({0..<t} × set ((Π)⇩𝒱)).
{{{ (State k (index ?vs v))¯
, (State (Suc k) (index ?vs v))⇧+ }
∪ {(Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op)}}})"]
by argo
qed
private lemma cnf_of_encode_goal_state_set_i:
"cnf ((Φ⇩G Π) t ) = ⋃({ cnf (encode_state_variable t
(index (strips_problem.variables_of Π) v) (((Π)⇩G) v))
| v. v ∈ set ((Π)⇩𝒱) ∧ ((Π)⇩G) v ≠ None })"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?G = "(Π)⇩G"
and ?Φ⇩G = "(Φ⇩G Π) t"
let ?fs = "map (λv. encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)
(filter (λv. ?G v ≠ None) ?vs)"
{
have "cnf ` set ?fs = cnf ` (λv. encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)
` { v | v. v ∈ set ?vs ∧ ?G v ≠ None }"
unfolding set_map
by force
also have "… = (λv. cnf (encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥))
` { v | v. v ∈ set ?vs ∧ ?G v ≠ None }"
using image_comp[of cnf "(λv. encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)"
"{ v | v. v ∈ set ?vs ∧ ?G v ≠ None }"]
by fast
finally have "cnf ` set ?fs = { cnf (encode_state_variable t (index ?vs v) (?G v))
| v. v ∈ set ?vs ∧ ?G v ≠ None }"
unfolding setcompr_eq_image[of "λv. cnf (encode_state_variable t (index ?vs v) (?G v) ❙∨ ⊥)"]
by auto
}
moreover have "cnf ((Φ⇩G Π) t) = ⋃ (cnf ` set ?fs)"
unfolding encode_goal_state_def SAT_Plan_Base.encode_goal_state_def Let_def
using cnf_BigAnd[of ?fs]
by force
ultimately show ?thesis
by simp
qed
corollary cnf_of_encode_goal_state_set_ii:
assumes "is_valid_problem_strips Π"
shows "cnf ((Φ⇩G Π) t) = ⋃({{{ literal_formula_to_literal
(encode_state_variable t (index (strips_problem.variables_of Π) v) (((Π)⇩G) v)) }}
| v. v ∈ set ((Π)⇩𝒱) ∧ ((Π)⇩G) v ≠ None })"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?G = "(Π)⇩G"
and ?Φ⇩G = "(Φ⇩G Π) t"
{
fix v
assume "v ∈ { v | v. v ∈ set ((Π)⇩𝒱) ∧ ?G v ≠ None }"
then have "v ∈ set ((Π)⇩𝒱)" and G_of_v_is_not_None: "?G v ≠ None"
by fast+
then consider (A) "?G v = Some True"
| (B) "?G v = Some False"
by fastforce
hence "cnf (encode_state_variable t (index ?vs v) (?G v))
= {{ literal_formula_to_literal (encode_state_variable t (index ?vs v) (?G v)) }}"
unfolding encode_state_variable_def
by (cases, force+)
} note nb = this
have "cnf ?Φ⇩G = ⋃({ cnf (encode_state_variable t (index ?vs v) (?G v))
| v. v ∈ set ((Π)⇩𝒱) ∧ ?G v ≠ None })"
unfolding cnf_of_encode_goal_state_set_i
by blast
also have "… = ⋃((λv. cnf (encode_state_variable t (index ?vs v) (((Π)⇩G) v)))
` { v | v. v ∈ set ((Π)⇩𝒱) ∧ ((Π)⇩G) v ≠ None })"
using setcompr_eq_image[of
"λv. cnf (encode_state_variable t (index ?vs v) (((Π)⇩G) v))"
"λv. v ∈ set ((Π)⇩𝒱) ∧ ((Π)⇩G) v ≠ None"]
by presburger
also have "… = ⋃((λv. {{ literal_formula_to_literal
(encode_state_variable t (index ?vs v) (?G v)) }})
` { v. v ∈ set ((Π)⇩𝒱) ∧ ((Π)⇩G) v ≠ None })"
using nb
by simp
finally show ?thesis
unfolding nb
by auto
qed
lemma cnf_of_encode_goal_state_set:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "v ∈ dom ((Π)⇩G)"
shows "((Π)⇩G) v = Some True ⟶ (∃!C. C ∈ cnf ((Φ⇩G Π) t)
∧ C = { (State t (index (strips_problem.variables_of Π) v))⇧+ })"
and "((Π)⇩G) v = Some False ⟶ (∃!C. C ∈ cnf ((Φ⇩G Π) t)
∧ C = { (State t (index (strips_problem.variables_of Π) v))¯ })"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?G = "(Π)⇩G"
and ?Φ⇩G = "(Φ⇩G Π) t"
have nb⇩1: "cnf ?Φ⇩G = ⋃ { cnf (encode_state_variable t (index ?vs v)
(?G v)) | v. v ∈ set ((Π)⇩𝒱) ∧ ?G v ≠ None }"
unfolding cnf_of_encode_goal_state_set_i
by auto
have nb⇩2: "v ∈ { v. v ∈ set ((Π)⇩𝒱) ∧ ?G v ≠ None }"
using is_valid_problem_dom_of_goal_state_is assms(1, 2)
by auto
have nb⇩3: "cnf (encode_state_variable t (index (strips_problem.variables_of Π) v) (((Π)⇩G) v))
⊆ (⋃{ cnf (encode_state_variable t (index ?vs v)
(?G v)) | v. v ∈ set ((Π)⇩𝒱) ∧ ?G v ≠ None })"
using UN_upper[OF nb⇩2, of "λv. cnf (encode_state_variable t (index ?vs v) (?G v))"] nb⇩2
by blast
show "((Π)⇩G) v = Some True ⟶ (∃!C. C ∈ cnf ((Φ⇩G Π) t)
∧ C = { (State t (index (strips_problem.variables_of Π) v))⇧+ })"
and "((Π)⇩G) v = Some False ⟶ (∃!C. C ∈ cnf ((Φ⇩G Π) t)
∧ C = { (State t (index (strips_problem.variables_of Π) v))¯ })"
using nb⇩3
unfolding nb⇩1 encode_state_variable_def
by auto+
qed
end
text ‹ We omit the proofs that the partial encoding functions produce formulas in CNF form due to
their more technical nature.
The following sublocale proof confirms that definition \ref{isadef:encode-problem-sat-plan-base}
encodes a valid problem \<^term>‹Π› into a formula that can be transformed to CNF
(\<^term>‹is_cnf (Φ Π t)›) and that its CNF has the required form. ›
subsection "Soundness of the Basic SATPlan Algorithm"
lemma valuation_models_encoding_cnf_formula_equals:
assumes "is_valid_problem_strips Π"
shows "𝒜 ⊨ Φ Π t = cnf_semantics 𝒜 (cnf (Φ Π t))"
proof -
let ?Φ = "Φ Π t"
{
have "is_cnf ?Φ"
using is_cnf_encode_problem[OF assms].
hence "is_nnf ?Φ"
using is_nnf_cnf
by blast
}
thus ?thesis
using cnf_semantics[of ?Φ 𝒜]
by blast
qed
corollary valuation_models_encoding_cnf_formula_equals_corollary:
assumes "is_valid_problem_strips Π"
shows "𝒜 ⊨ (Φ Π t)
= (∀C ∈ cnf (Φ Π t). ∃L ∈ C. lit_semantics 𝒜 L)"
using valuation_models_encoding_cnf_formula_equals[OF assms]
unfolding cnf_semantics_def clause_semantics_def encode_problem_def
by presburger
lemma decode_plan_length:
assumes "π = Φ¯ Π ν t"
shows "length π = t"
using assms
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
by simp
lemma decode_plan'_set_is[simp]:
"set (decode_plan' Π 𝒜 k)
= { (strips_problem.operators_of Π) ! (index (strips_problem.operators_of Π) op)
| op. op ∈ set (strips_problem.operators_of Π)
∧ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) }"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?f = "λop. Operator k (index ?ops op)"
let ?vs = "map ?f ?ops"
{
have "set (filter 𝒜 ?vs) = set (map ?f (filter (𝒜 ∘ ?f) ?ops))"
unfolding filter_map[of 𝒜 "λop. Operator k (index ?ops op)" ?ops]..
hence "set (filter 𝒜 ?vs) = (λop. Operator k (index ?ops op)) `
{ op ∈ set ?ops. 𝒜 (Operator k (index ?ops op)) }"
unfolding set_map set_filter
by simp
}
have "set (decode_plan' Π 𝒜 k) = (λv. case v of Operator k i ⇒ ?ops ! i)
` (λop. Operator k (index ?ops op)) ` { op ∈ set ?ops. 𝒜 (Operator k (index ?ops op)) }"
unfolding decode_plan'_def set_map Let_def
by auto
also have "… = (λop. case Operator k (index ?ops op) of Operator k i ⇒ ?ops ! i)
` { op ∈ set ?ops. 𝒜 (Operator k (index ?ops op)) }"
unfolding image_comp comp_apply
by argo
also have "… = (λop. ?ops ! (index ?ops op))
` { op ∈ set ?ops. 𝒜 (Operator k (index ?ops op)) }"
by force
finally show ?thesis
by blast
qed
lemma decode_plan_set_is[simp]:
"set (Φ¯ Π 𝒜 t) = (⋃k ∈ {..<t}. { decode_plan' Π 𝒜 k })"
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def set_map
using atLeast_upt
by blast
lemma decode_plan_step_element_then_i:
assumes "k < t"
shows "set ((Φ¯ Π 𝒜 t) ! k)
= { (strips_problem.operators_of Π) ! (index (strips_problem.operators_of Π) op)
| op. op ∈ set ((Π)⇩𝒪) ∧ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) }"
proof -
have "(Φ¯ Π 𝒜 t) ! k = decode_plan' Π 𝒜 k"
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
using assms
by simp
thus ?thesis
by force
qed
lemma decode_plan_step_element_then:
fixes Π::"'a strips_problem"
assumes "k < t"
and "op ∈ set ((Φ¯ Π 𝒜 t) ! k)"
shows "op ∈ set ((Π)⇩𝒪)"
and "𝒜 (Operator k (index (strips_problem.operators_of Π) op))"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?Ops = "{ ?ops ! (index ?ops op)
| op. op ∈ set ((Π)⇩𝒪) ∧ 𝒜 (Operator k (index ?ops op)) }"
have "op ∈ ?Ops"
using assms(2)
unfolding decode_plan_step_element_then_i[OF assms(1)] assms
by blast
moreover have "op ∈ set ((Π)⇩𝒪)"
and "𝒜 (Operator k (index ?ops op))"
using calculation
by fastforce+
ultimately show "op ∈ set ((Π)⇩𝒪)"
and "𝒜 (Operator k (index ?ops op))"
by blast+
qed
lemma decode_plan_step_distinct:
assumes "k < t"
shows "distinct ((Φ¯ Π 𝒜 t) ! k)"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?π⇩k = "(Φ¯ Π 𝒜 t) ! k"
let ?f = "λop. Operator k (index ?ops op)"
and ?g = "λv. case v of Operator _ k ⇒ ?ops ! k"
let ?vs = "map ?f (remdups ?ops)"
have nb⇩1: "?π⇩k = decode_plan' Π 𝒜 k"
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
using assms
by fastforce
{
have "distinct (remdups ?ops)"
by blast
moreover have "inj_on ?f (set (remdups ?ops))"
unfolding inj_on_def
by fastforce
ultimately have "distinct ?vs"
using distinct_map
by blast
} note nb⇩2 = this
{
have "inj_on ?g (set ?vs)"
unfolding inj_on_def
by fastforce
hence "distinct (map ?g ?vs)"
using distinct_map nb⇩2
by blast
}
thus ?thesis
using distinct_map_filter[of ?g ?vs 𝒜]
unfolding nb⇩1 decode_plan'_def Let_def
by argo
qed
lemma decode_state_at_valid_variable:
fixes Π :: "'a strips_problem"
assumes "(Φ⇩S¯ Π 𝒜 k) v ≠ None"
shows "v ∈ set ((Π)⇩𝒱)"
proof -
let ?vs = "strips_problem.variables_of Π"
let ?f = "λv. (v,𝒜 (State k (index ?vs v)))"
{
have "fst ` set (map ?f ?vs) = fst ` (λv. (v,𝒜 (State k (index ?vs v)))) ` set ?vs"
by force
also have "… = (λv. fst (v,𝒜 (State k (index ?vs v)))) ` set ?vs"
by blast
finally have "fst ` set (map ?f ?vs) = set ?vs"
by auto
}
moreover have "¬v ∉ fst ` set (map ?f ?vs)"
using map_of_eq_None_iff[of "map ?f ?vs" v] assms
unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
by meson
ultimately show ?thesis
by fastforce
qed
lemma decode_state_at_encoding_variables_equals_some_of_valuation_if:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k ≤ t"
and "v ∈ set ((Π)⇩𝒱)"
shows "(Φ⇩S¯ Π 𝒜 k) v
= Some (𝒜 (State k (index (strips_problem.variables_of Π) v)))"
proof -
let ?vs = "strips_problem.variables_of Π"
let ?l = "map (λx. (x,𝒜 (State k (index ?vs x)))) ?vs"
have "set ?vs ≠ {}"
using assms(4)
by fastforce
then have "map_of ?l v = Some (𝒜 (State k (index ?vs v)))"
using map_of_from_function_graph_is_some_if[of ?vs v
"λv. 𝒜 (State k (index ?vs v))"] assms(4)
by fastforce
thus ?thesis
unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
by meson
qed
lemma decode_state_at_dom:
assumes "is_valid_problem_strips Π"
shows "dom (Φ⇩S¯ Π 𝒜 k) = set ((Π)⇩𝒱)"
proof-
let ?s = "Φ⇩S¯ Π 𝒜 k"
and ?vs = "strips_problem.variables_of Π"
have "dom ?s = fst ` set (map (λv. (v, 𝒜 (State k (index ?vs v)))) ?vs)"
unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
using dom_map_of_conv_image_fst[of "(map (λv. (v, 𝒜 (State k (index ?vs v)))) ?vs)"]
by meson
also have "… = fst ` (λv. (v, 𝒜 (State k (index ?vs v)))) ` set ((Π)⇩𝒱)"
using set_map[of "(λv. (v, 𝒜 (State k (index ?vs v))))" ?vs]
by simp
also have "… = (fst ∘ (λv. (v, 𝒜 (State k (index ?vs v))))) ` set ((Π)⇩𝒱)"
using image_comp[of fst "(λv. (v, 𝒜 (State k (index ?vs v))))"]
by presburger
finally show ?thesis
by force
qed
lemma decode_state_at_initial_state:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
shows "(Φ⇩S¯ Π 𝒜 0) = (Π)⇩I"
proof -
let ?I = "(Π)⇩I"
let ?s = "Φ⇩S¯ Π 𝒜 0"
let ?vs = "strips_problem.variables_of Π"
let ?Φ = "Φ Π t"
let ?Φ⇩I = "Φ⇩I Π"
{
have "is_cnf ?Φ⇩I" and "cnf ?Φ⇩I ⊆ cnf ?Φ"
subgoal
using is_cnf_encode_initial_state[OF assms(1)]
by simp
subgoal
using cnf_of_encode_problem_structure(1)
unfolding encode_initial_state_def encode_problem_def
by blast
done
then have "cnf_semantics 𝒜 (cnf ?Φ⇩I)"
using cnf_semantics_monotonous_in_cnf_subsets_if is_cnf_encode_problem[OF assms(1)]
assms(2)
by blast
hence "∀C ∈ cnf ?Φ⇩I. clause_semantics 𝒜 C"
unfolding cnf_semantics_def encode_initial_state_def
by blast
} note nb⇩1 = this
{
{
fix v
assume v_in_dom_i: "v ∈ dom ?I"
moreover {
have v_in_variable_set: "v ∈ set ((Π)⇩𝒱)"
using is_valid_problem_strips_initial_of_dom assms(1) v_in_dom_i
by auto
hence "(Φ⇩S¯ Π 𝒜 0) v = Some (𝒜 (State 0 (index ?vs v)))"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) _ v_in_variable_set]
by fast
} note nb⇩2 = this
consider (v_initially_true) "?I v = Some True"
| (v_initially_false) "?I v = Some False"
using v_in_dom_i
by fastforce
hence "?I v = ?s v"
proof (cases)
case v_initially_true
then obtain C
where "C ∈ cnf ?Φ⇩I"
and c_is: "C = { (State 0 (index ?vs v))⇧+ }"
using cnf_of_encode_initial_state_set v_in_dom_i assms(1)
by fastforce
hence "𝒜 (State 0 (index ?vs v)) = True"
using nb⇩1
unfolding clause_semantics_def
by fastforce
thus ?thesis
using nb⇩2 v_initially_true
by presburger
next
case v_initially_false
then obtain C
where "C ∈ cnf ?Φ⇩I"
and c_is: "C = { (State 0 (index ?vs v))¯ }"
using cnf_of_encode_initial_state_set assms(1) v_in_dom_i
by fastforce
hence "𝒜 (State 0 (index ?vs v)) = False"
using nb⇩1
unfolding clause_semantics_def
by fastforce
thus ?thesis
using nb⇩2 v_initially_false
by presburger
qed
}
hence "?I ⊆⇩m ?s"
using map_le_def
by blast
} moreover {
{
fix v
assume v_in_dom_s: "v ∈ dom ?s"
then have v_in_set_vs: "v ∈ set ?vs"
using decode_state_at_dom[OF assms(1)]
by simp
have v_in_dom_I: "v ∈ dom ?I"
using is_valid_problem_strips_initial_of_dom assms(1) v_in_set_vs
by auto
have s_v_is: "(Φ⇩S¯ Π 𝒜 0) v = Some (𝒜 (State 0 (index ?vs v)))"
using decode_state_at_encoding_variables_equals_some_of_valuation_if assms(1, 2)
v_in_set_vs
by (metis le0)
consider (s_v_is_some_true) "?s v = Some True"
| (s_v_is_some_false) "?s v = Some False"
using v_in_dom_s
by fastforce
hence "?s v = ?I v"
proof (cases)
case s_v_is_some_true
then have 𝒜_of_s_v: "lit_semantics 𝒜 ((State 0 (index ?vs v))⇧+)"
using s_v_is
by fastforce
consider (I_v_is_some_true) "?I v = Some True"
| (I_v_is_some_false) "?I v = Some False"
using v_in_dom_I
by fastforce
thus ?thesis
proof (cases)
case I_v_is_some_true
then show ?thesis
using s_v_is_some_true
by argo
next
case I_v_is_some_false
then obtain C
where C_in_encode_initial_state: "C ∈ cnf ?Φ⇩I"
and C_is: "C = { (State 0 (index ?vs v))¯ }"
using cnf_of_encode_initial_state_set assms(1) v_in_dom_I
by fastforce
hence "lit_semantics 𝒜 ((State 0 (index ?vs v))¯)"
using nb⇩1
unfolding clause_semantics_def
by fast
thus ?thesis
using 𝒜_of_s_v
by fastforce
qed
next
case s_v_is_some_false
then have 𝒜_of_s_v: "lit_semantics 𝒜 ((State 0 (index ?vs v))¯)"
using s_v_is
by fastforce
consider (I_v_is_some_true) "?I v = Some True"
| (I_v_is_some_false) "?I v = Some False"
using v_in_dom_I
by fastforce
thus ?thesis
proof (cases)
case I_v_is_some_true
then obtain C
where C_in_encode_initial_state: "C ∈ cnf ?Φ⇩I"
and C_is: "C = { (State 0 (index ?vs v))⇧+ }"
using cnf_of_encode_initial_state_set assms(1) v_in_dom_I
by fastforce
hence "lit_semantics 𝒜 ((State 0 (index ?vs v))⇧+)"
using nb⇩1
unfolding clause_semantics_def
by fast
thus ?thesis
using 𝒜_of_s_v
by fastforce
next
case I_v_is_some_false
thus ?thesis
using s_v_is_some_false
by presburger
qed
qed
}
hence "?s ⊆⇩m ?I"
using map_le_def
by blast
} ultimately show ?thesis
using map_le_antisym
by blast
qed
lemma decode_state_at_goal_state:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
shows "(Π)⇩G ⊆⇩m Φ⇩S¯ Π 𝒜 t"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?G = "(Π)⇩G"
and ?G' = "Φ⇩S¯ Π 𝒜 t"
and ?Φ = "Φ Π t"
and ?Φ⇩G = "(Φ⇩G Π) t"
{
have "is_cnf ?Φ⇩G" and "cnf ?Φ⇩G ⊆ cnf ?Φ"
subgoal
using encode_goal_state_is_cnf[OF assms(1)]
by simp
subgoal
using cnf_of_encode_problem_structure(2)
unfolding encode_goal_state_def encode_problem_def
by blast
done
then have "cnf_semantics 𝒜 (cnf ?Φ⇩G)"
using cnf_semantics_monotonous_in_cnf_subsets_if is_cnf_encode_problem[OF assms(1)]
assms(2)
by blast
hence "∀C ∈ cnf ?Φ⇩G. clause_semantics 𝒜 C"
unfolding cnf_semantics_def encode_initial_state_def
by blast
} note nb⇩1 = this
{
fix v
assume "v ∈ set ((Π)⇩𝒱)"
moreover have "set ?vs ≠ {}"
using calculation(1)
by fastforce
moreover have "(Φ⇩S¯ Π 𝒜 t)
= map_of (map (λv. (v, 𝒜 (State t (index ?vs v)))) ?vs)"
unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
by metis
ultimately have "(Φ⇩S¯ Π 𝒜 t) v = Some (𝒜 (State t (index ?vs v)))"
using map_of_from_function_graph_is_some_if
by fastforce
} note nb⇩2 = this
{
fix v
assume v_in_dom_G: "v ∈ dom ?G"
then have v_in_vs: "v ∈ set ?vs"
using is_valid_problem_dom_of_goal_state_is assms(1)
by auto
then have decode_state_at_is: "(Φ⇩S¯ Π 𝒜 t) v = Some (𝒜 (State t (index ?vs v)))"
using nb⇩2
by fastforce
consider (A) "?G v = Some True"
| (B) "?G v = Some False"
using v_in_dom_G
by fastforce
hence "?G v = ?G' v"
proof (cases)
case A
{
obtain C where "C ⊆ cnf ?Φ⇩G" and "C = {{ (State t (index ?vs v))⇧+ }}"
using cnf_of_encode_goal_state_set(1)[OF assms(1) v_in_dom_G] A
by auto
then have "{ (State t (index ?vs v))⇧+ } ∈ cnf ?Φ⇩G"
by blast
then have "clause_semantics 𝒜 { (State t (index ?vs v))⇧+ }"
using nb⇩1
by blast
then have "lit_semantics 𝒜 ((State t (index ?vs v))⇧+)"
unfolding clause_semantics_def
by blast
hence "𝒜 (State t (index ?vs v)) = True"
by force
}
thus ?thesis
using decode_state_at_is A
by presburger
next
case B
{
obtain C where "C ⊆ cnf ?Φ⇩G" and "C = {{ (State t (index ?vs v))¯ }}"
using cnf_of_encode_goal_state_set(2)[OF assms(1) v_in_dom_G] B
by auto
then have "{ (State t (index ?vs v))¯ } ∈ cnf ?Φ⇩G"
by blast
then have "clause_semantics 𝒜 { (State t (index ?vs v))¯ }"
using nb⇩1
by blast
then have "lit_semantics 𝒜 ((State t (index ?vs v))¯)"
unfolding clause_semantics_def
by blast
hence "𝒜 (State t (index ?vs v)) = False"
by simp
}
thus ?thesis
using decode_state_at_is B
by presburger
qed
}
thus ?thesis
using map_le_def
by blast
qed
lemma decode_state_at_preconditions:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < t"
and "op ∈ set ((Φ¯ Π 𝒜 t) ! k)"
and "v ∈ set (precondition_of op)"
shows "𝒜 (State k (index (strips_problem.variables_of Π) v))"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Φ = "Φ Π t"
and ?Φ⇩O = "encode_operators Π t"
and ?Φ⇩P = "encode_all_operator_preconditions Π ?ops t"
{
have "𝒜 (Operator k (index ?ops op))"
and "op ∈ set ((Π)⇩𝒪)"
using decode_plan_step_element_then[OF assms(3, 4)]
by blast+
moreover obtain C
where clause_is_in_operator_encoding: "C ∈ cnf ?Φ⇩P"
and "C = { (Operator k (index ?ops op))¯,
(State k (index ?vs v))⇧+ }"
using cnf_of_encode_all_operator_preconditions_contains_clause_if[OF assms(1, 3)
calculation(2) assms(5)]
by blast
moreover have clause_semantics_𝒜_Φ⇩P: "∀C ∈ cnf ?Φ⇩P. clause_semantics 𝒜 C"
using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(2)
is_cnf_encode_problem[OF assms(1)]
cnf_of_operator_precondition_encoding_subset_encoding]
unfolding cnf_semantics_def
by blast
ultimately have "lit_semantics 𝒜 (Pos (State k (index ?vs v)))"
unfolding clause_semantics_def
by fastforce
}
thus ?thesis
unfolding lit_semantics_def
by fastforce
qed
lemma encode_problem_parallel_correct_i:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π 0"
shows "cnf ((Φ⇩G Π) 0) ⊆ cnf (Φ⇩I Π)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?Φ⇩I = "Φ⇩I Π"
and ?Φ⇩G = "(Φ⇩G Π) 0"
and ?Φ = "Φ Π 0"
have 𝒜_models_Φ⇩I: "𝒜 ⊨ ?Φ⇩I" and 𝒜_models_Φ⇩G: "𝒜 ⊨ ?Φ⇩G"
using assms(2) encode_problem_has_model_then_also_partial_encodings(1, 2)
unfolding encode_problem_def encode_initial_state_def encode_goal_state_def
by blast+
{
fix C'
assume C'_in_cnf_Φ⇩G: "C' ∈ cnf ?Φ⇩G"
then obtain v
where v_in_vs: "v ∈ set ?vs"
and G_of_v_is_not_None: "?G v ≠ None"
and C'_is: "C' = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v)
(?G v)) }"
using cnf_of_encode_goal_state_set_ii[OF assms(1)]
by auto
obtain C
where C_in_cnf_Φ⇩I: "C ∈ cnf ?Φ⇩I"
and C_is: "C = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v)
(?I v)) }"
using cnf_of_encode_initial_state_set_ii[OF assms(1)] v_in_vs
by auto
{
let ?L = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v))"
have "{ ?L } ∈ cnf ?Φ⇩I"
using C_in_cnf_Φ⇩I C_is
by blast
hence "lit_semantics 𝒜 ?L"
using model_then_all_singleton_clauses_modelled[OF
is_cnf_encode_initial_state[OF assms(1)]_ 𝒜_models_Φ⇩I]
by blast
} note lit_semantics_𝒜_L = this
{
let ?L' = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?G v))"
have "{ ?L' } ∈ cnf ?Φ⇩G"
using C'_in_cnf_Φ⇩G C'_is
by blast
hence "lit_semantics 𝒜 ?L'"
using model_then_all_singleton_clauses_modelled[OF
encode_goal_state_is_cnf[OF assms(1)]_ 𝒜_models_Φ⇩G]
by blast
} note lit_semantics_𝒜_L' = this
{
have "?I v = ?G v"
proof (rule ccontr)
assume contradiction: "?I v ≠ ?G v"
moreover have "?I v ≠ None"
using v_in_vs is_valid_problem_strips_initial_of_dom assms(1)
by auto
ultimately consider (A) "?I v = Some True ∧ ?G v = Some False"
| (B) "?I v = Some False ∧ ?G v = Some True"
using G_of_v_is_not_None
by force
thus False
using lit_semantics_𝒜_L lit_semantics_𝒜_L'
unfolding encode_state_variable_def
by (cases, fastforce+)
qed
}
hence "C' ∈ cnf ?Φ⇩I"
using C_is C_in_cnf_Φ⇩I C'_is C'_in_cnf_Φ⇩G
by argo
}
thus ?thesis
by blast
qed
lemma encode_problem_parallel_correct_ii:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < length (Φ¯ Π 𝒜 t)"
shows "are_all_operators_applicable (Φ⇩S¯ Π 𝒜 k)
((Φ¯ Π 𝒜 t) ! k)"
and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?π = "Φ¯ Π 𝒜 t"
and ?s = "Φ⇩S¯ Π 𝒜 k"
let ?Φ = "Φ Π t"
and ?Φ⇩E = "encode_all_operator_effects Π ?ops t"
have k_lt_t: "k < t"
using decode_plan_length assms(3)
by metis
{
{
fix op v
assume op_in_kth_of_decoded_plan_set: "op ∈ set (?π ! k)"
and v_in_precondition_set: "v ∈ set (precondition_of op)"
{
have "𝒜 (Operator k (index ?ops op))"
using decode_plan_step_element_then[OF k_lt_t op_in_kth_of_decoded_plan_set]
by blast
hence "𝒜 (State k (index ?vs v))"
using decode_state_at_preconditions[
OF assms(1, 2) _ op_in_kth_of_decoded_plan_set v_in_precondition_set] k_lt_t
by blast
}
moreover have "k ≤ t"
using k_lt_t
by auto
moreover {
have "op ∈ set ((Π)⇩𝒪)"
using decode_plan_step_element_then[OF k_lt_t op_in_kth_of_decoded_plan_set]
by simp
then have "v ∈ set ((Π)⇩𝒱)"
using is_valid_problem_strips_operator_variable_sets(1) assms(1)
v_in_precondition_set
by auto
}
ultimately have "(Φ⇩S¯ Π 𝒜 k) v = Some True"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF assms(1, 2)]
by presburger
}
hence "are_all_operators_applicable ?s (?π ! k)"
using are_all_operators_applicable_set[of ?s "?π ! k"]
by blast
} moreover {
{
fix op⇩1 op⇩2
assume op⇩1_in_k_th_of_decoded_plan: "op⇩1 ∈ set ((Φ¯ Π 𝒜 t) ! k)"
and op⇩2_in_k_th_of_decoded_plan: "op⇩2 ∈ set ((Φ¯ Π 𝒜 t) ! k)"
have op⇩1_in_set_ops: "op⇩1 ∈ set ((Π)⇩𝒪)"
and op⇩2_in_set_ops: "op⇩2 ∈ set ((Π)⇩𝒪)"
and op⇩1_active_at_k: "¬lit_semantics 𝒜 ((Operator k (index ?ops op⇩1))¯)"
and op⇩2_active_at_k: "¬lit_semantics 𝒜 ((Operator k (index ?ops op⇩2))¯)"
subgoal
using decode_plan_step_element_then[OF k_lt_t op⇩1_in_k_th_of_decoded_plan]
by simp
subgoal
using decode_plan_step_element_then[OF k_lt_t op⇩2_in_k_th_of_decoded_plan]
by force
subgoal
using decode_plan_step_element_then[OF k_lt_t op⇩1_in_k_th_of_decoded_plan]
by simp
subgoal
using decode_plan_step_element_then[OF k_lt_t op⇩2_in_k_th_of_decoded_plan]
by simp
done
{
fix v
assume v_in_add_effects_set_of_op⇩1: "v ∈ set (add_effects_of op⇩1)"
and v_in_delete_effects_set_of_op⇩2: "v ∈ set (delete_effects_of op⇩2)"
let ?C⇩1 = "{(Operator k (index ?ops op⇩1))¯,
(State (Suc k) (index ?vs v))⇧+}"
and ?C⇩2 = "{(Operator k (index ?ops op⇩2))¯,
(State (Suc k) (index ?vs v))¯}"
have "?C⇩1 ∈ cnf ?Φ⇩E" and "?C⇩2 ∈ cnf ?Φ⇩E"
subgoal
using cnf_of_operator_effect_encoding_contains_add_effect_clause_if[OF
assms(1) k_lt_t op⇩1_in_set_ops v_in_add_effects_set_of_op⇩1]
by blast
subgoal
using cnf_of_operator_effect_encoding_contains_delete_effect_clause_if[OF
assms(1) k_lt_t op⇩2_in_set_ops v_in_delete_effects_set_of_op⇩2]
by blast
done
then have "?C⇩1 ∈ cnf ?Φ" and "?C⇩2 ∈ cnf ?Φ"
using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
by blast+
then have C⇩1_true: "clause_semantics 𝒜 ?C⇩1" and C⇩2_true: "clause_semantics 𝒜 ?C⇩2"
using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
unfolding cnf_semantics_def
by blast+
have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))⇧+)"
and "lit_semantics 𝒜 ((State (k + 1) (index ?vs v))¯)"
subgoal
using op⇩1_active_at_k C⇩1_true
unfolding clause_semantics_def
by blast
subgoal
using op⇩2_active_at_k C⇩2_true
unfolding clause_semantics_def
by fastforce
done
hence False
by auto
} moreover {
fix v
assume v_in_delete_effects_set_of_op⇩1: "v ∈ set (delete_effects_of op⇩1)"
and v_in_add_effects_set_of_op⇩2: "v ∈ set (add_effects_of op⇩2)"
let ?C⇩1 = "{(Operator k (index ?ops op⇩1))¯, (State (Suc k) (index ?vs v))¯}"
and ?C⇩2 = "{(Operator k (index ?ops op⇩2))¯, (State (Suc k) (index ?vs v))⇧+}"
have "?C⇩1 ∈ cnf ?Φ⇩E" and "?C⇩2 ∈ cnf ?Φ⇩E"
subgoal
using cnf_of_operator_effect_encoding_contains_delete_effect_clause_if[OF
assms(1) k_lt_t op⇩1_in_set_ops v_in_delete_effects_set_of_op⇩1]
by fastforce
subgoal
using cnf_of_operator_effect_encoding_contains_add_effect_clause_if[OF
assms(1) k_lt_t op⇩2_in_set_ops v_in_add_effects_set_of_op⇩2]
by simp
done
then have "?C⇩1 ∈ cnf ?Φ" and "?C⇩2 ∈ cnf ?Φ"
using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
by blast+
then have C⇩1_true: "clause_semantics 𝒜 ?C⇩1" and C⇩2_true: "clause_semantics 𝒜 ?C⇩2"
using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
unfolding cnf_semantics_def
by blast+
have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))¯)"
and "lit_semantics 𝒜 ((State (k + 1) (index ?vs v))⇧+)"
subgoal
using op⇩1_active_at_k C⇩1_true
unfolding clause_semantics_def
by blast
subgoal
using op⇩2_active_at_k C⇩2_true
unfolding clause_semantics_def
by fastforce
done
hence False
by simp
}
ultimately have "set (add_effects_of op⇩1) ∩ set (delete_effects_of op⇩2) = {}"
and "set (delete_effects_of op⇩1) ∩ set (add_effects_of op⇩2) = {}"
by blast+
}
hence "are_all_operator_effects_consistent (?π ! k)"
using are_all_operator_effects_consistent_set[of "?π ! k"]
by blast
}
ultimately show "are_all_operators_applicable ?s (?π ! k)"
and "are_all_operator_effects_consistent (?π ! k)"
by blast+
qed
lemma encode_problem_parallel_correct_iii:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < length (Φ¯ Π 𝒜 t)"
and "op ∈ set ((Φ¯ Π 𝒜 t) ! k)"
shows "v ∈ set (add_effects_of op)
⟶ (Φ⇩S¯ Π 𝒜 (Suc k)) v = Some True"
and "v ∈ set (delete_effects_of op)
⟶ (Φ⇩S¯ Π 𝒜 (Suc k)) v = Some False"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
let ?Φ⇩F = "encode_all_operator_effects Π ?ops t"
and ?A = "(⋃(t, op)∈{0..<t} × set ((Π)⇩𝒪).
{{{ (Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))⇧+ }}
| v. v ∈ set (add_effects_of op)})"
and ?B = "(⋃(t, op)∈{0..<t} × set ((Π)⇩𝒪).
{{{ (Operator t (index ?ops op))¯,
(State (Suc t) (index ?vs v))¯ }}
| v. v ∈ set (delete_effects_of op)})"
have k_lt_t: "k < t"
using decode_plan_length assms(3)
by metis
have op_is_valid: "op ∈ set ((Π)⇩𝒪)"
using decode_plan_step_element_then[OF k_lt_t assms(4)]
by blast
have k_op_included: "(k, op) ∈ ({0..<t} × set ((Π)⇩𝒪))"
using k_lt_t op_is_valid
by fastforce
thus "v ∈ set (add_effects_of op)
⟶ (Φ⇩S¯ Π 𝒜 (Suc k)) v = Some True"
and "v ∈ set (delete_effects_of op)
⟶ (Φ⇩S¯ Π 𝒜 (Suc k)) v = Some False"
proof (auto)
assume v_is_add_effect: "v ∈ set (add_effects_of op)"
have "𝒜 (Operator k (index ?ops op))"
using decode_plan_step_element_then[OF k_lt_t assms(4)]
by blast
moreover {
have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}}
∈ {{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}}
| v. v ∈ set (add_effects_of op)}"
using v_is_add_effect
by blast
then have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}} ∈ ?A"
using k_op_included cnf_of_operator_encoding_structure
UN_iff[of "{{(Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))⇧+}}"
_ "{0..<t} × set ((Π)⇩𝒪)"]
by blast
then have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+} ∈ ⋃ ?A"
using Union_iff[of "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+}"]
by blast
moreover have "⋃?A ⊆ cnf ?Φ⇩F"
using cnf_of_encode_all_operator_effects_structure
by blast
ultimately have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+} ∈ cnf ?Φ⇩F"
using in_mono[of "⋃?A" "cnf ?Φ⇩F"]
by presburger
}
ultimately have "𝒜 (State (Suc k) (index ?vs v))"
using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
assms(2)[unfolded valuation_models_encoding_cnf_formula_equals_corollary[OF assms(1)]]
unfolding Bex_def
by fastforce
thus "(Φ⇩S¯ Π 𝒜 (Suc k)) v = Some True"
using assms(1) assms(2)
decode_state_at_encoding_variables_equals_some_of_valuation_if
is_valid_problem_strips_operator_variable_sets(2) k_lt_t op_is_valid subsetD
v_is_add_effect
by fastforce
next
assume v_is_delete_effect: "v ∈ set (delete_effects_of op)"
have "𝒜 (Operator k (index ?ops op))"
using decode_plan_step_element_then[OF k_lt_t assms(4)]
by blast
moreover {
have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}}
∈ {{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}}
| v. v ∈ set (delete_effects_of op)}"
using v_is_delete_effect
by blast
then have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}} ∈ ?B"
using k_op_included cnf_of_encode_all_operator_effects_structure
UN_iff[of "{{(Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))⇧+}}"
_ "{0..<t} × set ((Π)⇩𝒪)"]
by blast
then have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯} ∈ ⋃ ?B"
using Union_iff[of "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}"]
by blast
moreover have "⋃?B ⊆ cnf ?Φ⇩F"
using cnf_of_encode_all_operator_effects_structure Un_upper2[of "⋃?B" "⋃?A"]
by fast
ultimately have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯} ∈ cnf ?Φ⇩F"
using in_mono[of "⋃?B" "cnf ?Φ⇩F"]
by presburger
}
ultimately have "¬𝒜 (State (Suc k) (index ?vs v))"
using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
valuation_models_encoding_cnf_formula_equals_corollary[OF assms(1)] assms(2)
by fastforce
moreover have "Suc k ≤ t"
using k_lt_t
by fastforce
moreover have "v ∈ set((Π)⇩𝒱)"
using v_is_delete_effect is_valid_problem_strips_operator_variable_sets(3) assms(1)
op_is_valid
by auto
ultimately show "(Φ⇩S¯ Π 𝒜 (Suc k)) v = Some False"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF assms(1, 2)]
by auto
qed
qed
lemma encode_problem_parallel_correct_iv:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < t"
and "v ∈ set ((Π)⇩𝒱)"
and "¬(∃op ∈ set ((Φ¯ Π 𝒜 t) ! k).
v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op))"
shows "cnf_semantics 𝒜 {{ (State k (index (strips_problem.variables_of Π) v))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }}"
and "cnf_semantics 𝒜 {{ (State k (index (strips_problem.variables_of Π) v))⇧+
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
let ?Φ = "Φ Π t"
and ?Φ⇩F = "encode_all_frame_axioms Π t"
and ?π⇩k = "(Φ¯ Π 𝒜 t) ! k"
and ?A = "⋃(k, v) ∈ ({0..<t} × set ?vs).
{{{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}}"
and ?B = "⋃(k, v) ∈ ({0..<t} × set ?vs).
{{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }}}"
and ?C = "{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ {(Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
and ?C' = "{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
have k_v_included: "(k, v) ∈ ({..<t} × set ((Π)⇩𝒱))"
using assms(3, 4)
by blast
have operator_encoding_subset_encoding: "cnf ?Φ⇩F ⊆ cnf ?Φ"
using cnf_of_encode_problem_structure(4)
unfolding encode_problem_def
by fast
{
let ?add = "{ ((Operator k (index ?ops op))⇧+)
| op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
and ?delete = "{ ((Operator k (index ?ops op))⇧+)
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
{
fix op
assume operator_encoding_in_add: "(Operator k (index ?ops op))⇧+ ∈ ?add"
hence "¬lit_semantics 𝒜 ((Operator k (index ?ops op))⇧+)"
proof (cases "op ∈ set ?π⇩k")
case True
then have "v ∉ set (add_effects_of op)"
using assms(5)
by simp
then have "(Operator k (index ?ops op))⇧+ ∉ ?add"
by fastforce
thus ?thesis
using operator_encoding_in_add
by blast
next
case False
then show ?thesis
proof (cases "op ∈ set ?ops")
case True
{
let ?A = "{ ?ops ! index ?ops op |op.
op ∈ set ((Π)⇩𝒪) ∧ 𝒜 (Operator k (index ?ops op))}"
assume "lit_semantics 𝒜 ((Operator k (index ?ops op))⇧+)"
moreover have operator_active_at_k: "𝒜 (Operator k (index ?ops op))"
using calculation
by auto
moreover have "op ∈ set ((Π)⇩𝒪)"
using True
by force
moreover have "(?ops ! index ?ops op) ∈ ?A"
using calculation(2, 3)
by blast
ultimately have "op ∈ set ?π⇩k"
using decode_plan_step_element_then_i[OF assms(3)]
by auto
hence False
using False
by blast
}
thus ?thesis
by blast
next
case False
then have "op ∉ {op ∈ set ?ops. v ∈ set (add_effects_of op)}"
by blast
moreover have "?add =
(λop. (Operator k (index ?ops op))⇧+)
` { op ∈ set ?ops. v ∈ set (add_effects_of op) }"
using setcompr_eq_image[of "λop. (Operator k (index ?ops op))⇧+"
"λop. op ∈ set ?ops ∧ v ∈ set (add_effects_of op)"]
by blast
ultimately have "(Operator k (index ?ops op))⇧+ ∉ ?add"
by force
thus ?thesis using operator_encoding_in_add
by blast
qed
qed
} moreover {
fix op
assume operator_encoding_in_delete: "((Operator k (index ?ops op))⇧+) ∈ ?delete"
hence "¬lit_semantics 𝒜 ((Operator k (index ?ops op))⇧+)"
proof (cases "op ∈ set ?π⇩k")
case True
then have "v ∉ set (delete_effects_of op)"
using assms(5)
by simp
then have "(Operator k (index ?ops op))⇧+ ∉ ?delete"
by fastforce
thus ?thesis
using operator_encoding_in_delete
by blast
next
case False
then show ?thesis
proof (cases "op ∈ set ?ops")
case True
{
let ?A = "{ ?ops ! index ?ops op |op.
op ∈ set ((Π)⇩𝒪) ∧ 𝒜 (Operator k (index ?ops op))}"
assume "lit_semantics 𝒜 ((Operator k (index ?ops op))⇧+)"
moreover have operator_active_at_k: "𝒜 (Operator k (index ?ops op))"
using calculation
by auto
moreover have "op ∈ set ((Π)⇩𝒪)"
using True
by force
moreover have "(?ops ! index ?ops op) ∈ ?A"
using calculation(2, 3)
by blast
ultimately have "op ∈ set ?π⇩k"
using decode_plan_step_element_then_i[OF assms(3)]
by auto
hence False
using False
by blast
}
thus ?thesis
by blast
next
case False
then have "op ∉ { op ∈ set ?ops. v ∈ set (delete_effects_of op) }"
by blast
moreover have "?delete =
(λop. (Operator k (index ?ops op))⇧+)
` { op ∈ set ?ops. v ∈ set (delete_effects_of op) }"
using setcompr_eq_image[of "λop. (Operator k (index ?ops op))⇧+"
"λop. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op)"]
by blast
ultimately have "(Operator k (index ?ops op))⇧+ ∉ ?delete"
by force
thus ?thesis using operator_encoding_in_delete
by blast
qed
qed
}
ultimately have "∀op. op ∈ ?add ⟶ ¬lit_semantics 𝒜 op"
and "∀op. op ∈ ?delete ⟶ ¬lit_semantics 𝒜 op"
by blast+
} note nb = this
{
let ?Ops = "{ (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
have "?Ops ⊆ ?C"
by blast
moreover have "?C - ?Ops = { (State k (index ?vs v))⇧+ , (State (Suc k) (index ?vs v))¯ }"
by fast
moreover have "∀L ∈ ?Ops. ¬ lit_semantics 𝒜 L"
using nb(1)
by blast
ultimately have "clause_semantics 𝒜 ?C
= clause_semantics 𝒜 { (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }"
using lit_semantics_reducible_to_subset_if[of ?Ops ?C]
by presburger
} moreover {
let ?Ops' = "{ (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
have "?Ops' ⊆ ?C'"
by blast
moreover have "?C' - ?Ops' = { (State k (index ?vs v))¯ , (State (Suc k) (index ?vs v))⇧+ }"
by fast
moreover have "∀L ∈ ?Ops'. ¬ lit_semantics 𝒜 L"
using nb(2)
by blast
ultimately have "clause_semantics 𝒜 ?C'
= clause_semantics 𝒜 { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }"
using lit_semantics_reducible_to_subset_if[of ?Ops' ?C']
by presburger
} moreover {
have cnf_semantics_𝒜_Φ:"cnf_semantics 𝒜 (cnf ?Φ)"
using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
by blast
have k_v_included: "(k, v) ∈ ({..<t} × set ((Π)⇩𝒱))"
using assms(3, 4)
by blast
have c_in_un_a: "?C ∈ ⋃?A" and c'_in_un_b: "?C' ∈ ⋃?B"
using k_v_included
by force+
then have "?C ∈ cnf ?Φ⇩F" and "?C' ∈ cnf ?Φ⇩F"
subgoal
using cnf_of_encode_all_frame_axioms_structure UnI1[of "?C" "⋃?A" "⋃?B"] c_in_un_a
by metis
subgoal
using cnf_of_encode_all_frame_axioms_structure UnI2[of "?C'" "⋃?B" "⋃?A"] c'_in_un_b
by metis
done
then have "{ ?C } ⊆ cnf ?Φ⇩F" and c'_subset_frame_axiom_encoding: "{ ?C' } ⊆ cnf ?Φ⇩F"
by blast+
then have "{ ?C } ⊆ cnf ?Φ" and "{ ?C' } ⊆ cnf ?Φ"
subgoal
using operator_encoding_subset_encoding
by fast
subgoal
using c'_subset_frame_axiom_encoding operator_encoding_subset_encoding
by fast
done
hence "cnf_semantics 𝒜 { ?C }" and "cnf_semantics 𝒜 { ?C' }"
using cnf_semantics_𝒜_Φ model_for_cnf_is_model_of_all_subsets
by fastforce+
}
ultimately show "cnf_semantics 𝒜 {{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }}"
and "cnf_semantics 𝒜 {{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }}"
unfolding cnf_semantics_def
by blast+
qed
lemma encode_problem_parallel_correct_v:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < length (Φ¯ Π 𝒜 t)"
shows "(Φ⇩S¯ Π 𝒜 (Suc k)) = execute_parallel_operator (Φ⇩S¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?π = "Φ¯ Π 𝒜 t"
and ?s⇩k = "Φ⇩S¯ Π 𝒜 k"
and ?s⇩k' = "Φ⇩S¯ Π 𝒜 (Suc k)"
let ?t⇩k' = "execute_parallel_operator ?s⇩k (?π ! k)"
and ?π⇩k = "?π ! k"
have k_lt_t: "k < t" and k_lte_t: "k ≤ t" and suc_k_lte_t: "Suc k ≤ t"
using decode_plan_length[of ?π Π 𝒜 t] assms(3)
by (argo, fastforce+)
then have operator_preconditions_hold:
"are_all_operators_applicable ?s⇩k ?π⇩k ∧ are_all_operator_effects_consistent ?π⇩k"
using encode_problem_parallel_correct_ii[OF assms(1, 2, 3)]
by blast
moreover {
{
fix v
assume v_in_dom_s⇩k':"v ∈ dom ?s⇩k'"
then have s⇩k'_not_none: "?s⇩k' v ≠ None"
by blast
hence "?s⇩k' v = ?t⇩k' v"
proof (cases "∃op ∈ set ?π⇩k. v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op)")
case True
then obtain op
where op_in_π⇩k: "op ∈ set ?π⇩k"
and "v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op)"
by blast
then consider (v_is_add_effect) "v ∈ set (add_effects_of op)"
| (v_is_delete_effect) "v ∈ set (delete_effects_of op)"
by blast
then show ?thesis
proof (cases)
case v_is_add_effect
then have "?s⇩k' v = Some True"
using encode_problem_parallel_correct_iii(1)[OF assms(1, 2, 3) op_in_π⇩k]
v_is_add_effect
by blast
moreover have "are_all_operators_applicable (Φ⇩S¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
using operator_preconditions_hold v_is_add_effect
by blast+
moreover have "?t⇩k' v = Some True"
using execute_parallel_operator_positive_effect_if[of
"Φ⇩S¯ Π 𝒜 k" "(Φ¯ Π 𝒜 t) ! k"] op_in_π⇩k
v_is_add_effect calculation(2, 3)
by blast
ultimately show ?thesis
by argo
next
case v_is_delete_effect
then have "?s⇩k' v = Some False"
using encode_problem_parallel_correct_iii(2)[OF assms(1, 2, 3) op_in_π⇩k]
v_is_delete_effect
by blast
moreover have "are_all_operators_applicable (Φ⇩S¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
using operator_preconditions_hold
by blast+
moreover have "?t⇩k' v = Some False"
using execute_parallel_operator_effect(2) op_in_π⇩k
v_is_delete_effect calculation(2, 3)
by fast
moreover have "?t⇩k' v = Some False"
by (meson execute_parallel_operator_negative_effect_if op_in_π⇩k operator_preconditions_hold v_is_delete_effect)
ultimately show ?thesis
by argo
qed
next
case False
then have "?t⇩k' v = ?s⇩k v"
using execute_parallel_operator_no_effect_if
by fastforce
moreover {
have v_in_set_vs: "v ∈ set ((Π)⇩𝒱)"
using decode_state_at_valid_variable[OF s⇩k'_not_none].
then have state_propagation_positive:
"cnf_semantics 𝒜 {{(State k (index ?vs v))¯
, (State (Suc k) (index ?vs v))⇧+}}"
and state_propagation_negative:
"cnf_semantics 𝒜 {{(State k (index ?vs v))⇧+
, (State (Suc k) (index ?vs v))¯}}"
using encode_problem_parallel_correct_iv[OF assms(1, 2) k_lt_t _ False]
by fastforce+
consider (s⇩k'_v_positive) "?s⇩k' v = Some True"
| (s⇩k'_v_negative) "?s⇩k' v = Some False"
using s⇩k'_not_none
by fastforce
hence "?s⇩k' v = ?s⇩k v"
proof (cases)
case s⇩k'_v_positive
then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))⇧+)"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) suc_k_lte_t v_in_set_vs]
by fastforce
then have "lit_semantics 𝒜 ((State k (index ?vs v))⇧+)"
using state_propagation_negative
unfolding cnf_semantics_def clause_semantics_def
by fastforce
then show ?thesis
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) k_lte_t v_in_set_vs] s⇩k'_v_positive
by fastforce
next
case s⇩k'_v_negative
then have "¬lit_semantics 𝒜 ((State (Suc k) (index ?vs v))⇧+)"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[
OF assms(1, 2) suc_k_lte_t v_in_set_vs]
by fastforce
then have "¬lit_semantics 𝒜 ((State k (index ?vs v))⇧+)"
using state_propagation_positive
unfolding cnf_semantics_def clause_semantics_def
by fastforce
then show ?thesis
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) k_lte_t v_in_set_vs] s⇩k'_v_negative
by fastforce
qed
}
ultimately show ?thesis
by argo
qed
}
hence "?s⇩k' ⊆⇩m ?t⇩k'"
using map_le_def
by blast
}
moreover {
{
fix v
assume "v ∈ dom ?t⇩k'"
then have t⇩k'_not_none: "?t⇩k' v ≠ None"
by blast
{
{
assume contradiction: "v ∉ set ((Π)⇩𝒱)"
then have "(Φ⇩S¯ Π 𝒜 k) v = None"
using decode_state_at_valid_variable
by fastforce
then obtain op
where op_in: "op ∈ set ((Φ¯ Π 𝒜 t) ! k)"
and v_is_or: "v ∈ set (add_effects_of op)
∨ v ∈ set (delete_effects_of op)"
using execute_parallel_operators_strips_none_if_contraposition[OF
t⇩k'_not_none]
by blast
have op_in: "op ∈ set ((Π)⇩𝒪)"
using op_in decode_plan_step_element_then(1) k_lt_t
by blast
consider (A) "v ∈ set (add_effects_of op)"
| (B) "v ∈ set (delete_effects_of op)"
using v_is_or
by blast
hence False
proof (cases)
case A
then have "v ∈ set ((Π)⇩𝒱)"
using is_valid_problem_strips_operator_variable_sets(2)[OF
assms(1)] op_in A
by blast
thus False
using contradiction
by blast
next
case B
then have "v ∈ set ((Π)⇩𝒱)"
using is_valid_problem_strips_operator_variable_sets(3)[OF
assms(1)] op_in B
by blast
thus False
using contradiction
by blast
qed
}
}
hence v_in_set_vs: "v ∈ set ((Π)⇩𝒱)"
by blast
hence "?t⇩k' v = ?s⇩k' v"
proof (cases "(∃op∈set ?π⇩k. v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op))")
case True
then obtain op
where op_in_set_π⇩k: "op ∈ set ?π⇩k"
and v_options: "v ∈ set (add_effects_of op) ∨ v ∈ set (delete_effects_of op)"
by blast
then have "op ∈ set ((Π)⇩𝒪)"
using decode_plan_step_element_then[OF k_lt_t]
by blast
then consider (v_is_add_effect) "v ∈ set (add_effects_of op)"
| (v_is_delete_effect) "v ∈ set (delete_effects_of op)"
using v_options
by blast
thus ?thesis
proof (cases)
case v_is_add_effect
then have "?t⇩k' v = Some True"
using execute_parallel_operator_positive_effect_if[OF _ _ op_in_set_π⇩k]
operator_preconditions_hold
by blast
moreover have "?s⇩k' v = Some True"
using encode_problem_parallel_correct_iii(1)[OF assms(1, 2, 3) op_in_set_π⇩k]
v_is_add_effect
by blast
ultimately show ?thesis
by argo
next
case v_is_delete_effect
then have "?t⇩k' v = Some False"
using execute_parallel_operator_negative_effect_if[OF _ _ op_in_set_π⇩k]
operator_preconditions_hold
by blast
moreover have "?s⇩k' v = Some False"
using encode_problem_parallel_correct_iii(2)[OF assms(1, 2, 3) op_in_set_π⇩k]
v_is_delete_effect
by blast
ultimately show ?thesis
by argo
qed
next
case False
have state_propagation_positive:
"cnf_semantics 𝒜 {{(State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+}}"
and state_propagation_negative:
"cnf_semantics 𝒜 {{(State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯}}"
using encode_problem_parallel_correct_iv[OF assms(1, 2) k_lt_t v_in_set_vs
False]
by blast+
{
have all_op_in_set_π⇩k_have_no_effect:
"∀op ∈ set ?π⇩k. v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)"
using False
by blast
then have "?t⇩k' v = ?s⇩k v"
using execute_parallel_operator_no_effect_if[OF all_op_in_set_π⇩k_have_no_effect]
by blast
} note t⇩k'_equals_s⇩k = this
{
have "?s⇩k v ≠ None"
using t⇩k'_not_none t⇩k'_equals_s⇩k
by argo
then consider (s⇩k_v_is_some_true) "?s⇩k v = Some True"
| (s⇩k_v_is_some_false) "?s⇩k v = Some False"
by fastforce
}
then show ?thesis
proof (cases)
case s⇩k_v_is_some_true
moreover {
have "lit_semantics 𝒜 ((State k (index ?vs v))⇧+)"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) k_lte_t v_in_set_vs] s⇩k_v_is_some_true
by simp
then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))⇧+)"
using state_propagation_positive
unfolding cnf_semantics_def clause_semantics_def
by fastforce
then have "?s⇩k' v = Some True"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) suc_k_lte_t v_in_set_vs]
by fastforce
}
ultimately show ?thesis
using t⇩k'_equals_s⇩k
by simp
next
case s⇩k_v_is_some_false
moreover {
have "lit_semantics 𝒜 ((State k (index ?vs v))¯)"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) k_lte_t v_in_set_vs] s⇩k_v_is_some_false
by simp
then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))¯)"
using state_propagation_negative
unfolding cnf_semantics_def clause_semantics_def
by fastforce
then have "?s⇩k' v = Some False"
using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
assms(1, 2) suc_k_lte_t v_in_set_vs]
by fastforce
}
ultimately show ?thesis
using t⇩k'_equals_s⇩k
by simp
qed
qed
}
hence "?t⇩k' ⊆⇩m ?s⇩k'"
using map_le_def
by blast
}
ultimately show ?thesis
using map_le_antisym
by blast
qed
lemma encode_problem_parallel_correct_vi:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "k < length (trace_parallel_plan_strips ((Π)⇩I) (Φ¯ Π 𝒜 t))"
shows "trace_parallel_plan_strips ((Π)⇩I) (Φ¯ Π 𝒜 t) ! k
= Φ⇩S¯ Π 𝒜 k"
using assms
proof -
let ?I = "(Π)⇩I"
and ?π = "Φ¯ Π 𝒜 t"
let ?τ = "trace_parallel_plan_strips ?I ?π"
show ?thesis
using assms
proof (induction k)
case 0
hence "?τ ! 0 = ?I"
using trace_parallel_plan_strips_head_is_initial_state
by blast
moreover have "Φ⇩S¯ Π 𝒜 0 = ?I"
using decode_state_at_initial_state[OF assms(1, 2)]
by simp
ultimately show ?case
by simp
next
case (Suc k)
let ?τ⇩k = "trace_parallel_plan_strips ?I ?π ! k"
and ?s⇩k = "Φ⇩S¯ Π 𝒜 k"
have k_lt_length_τ_minus_one: "k < length ?τ - 1" and k_lt_length_τ: "k < length ?τ"
using Suc.prems(3)
by linarith+
{
have "?τ ! k = execute_parallel_plan ?I (take k ?π)"
using trace_parallel_plan_plan_prefix k_lt_length_τ
by blast
hence "?τ⇩k = ?s⇩k"
using Suc.IH[OF assms(1, 2) k_lt_length_τ]
by blast
}
moreover have "trace_parallel_plan_strips ?I ?π ! Suc k
= execute_parallel_operator ?τ⇩k (?π ! k)"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
by blast
moreover {
thm Suc.prems(3)
have "length (trace_parallel_plan_strips ?I ?π) ≤ length ?π + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one
by blast
then have "k < length ?π"
using Suc.prems(3)
unfolding Suc_eq_plus1
by linarith
hence "Φ⇩S¯ Π 𝒜 (Suc k)
= execute_parallel_operator ?s⇩k (?π ! k)"
using encode_problem_parallel_correct_v[OF assms(1, 2)]
by simp
}
ultimately show ?case
by argo
qed
qed
lemma encode_problem_parallel_correct_vii:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
shows "length (map (decode_state_at Π 𝒜)
[0..<Suc (length (Φ¯ Π 𝒜 t))])
= length (trace_parallel_plan_strips ((Π)⇩I) (Φ¯ Π 𝒜 t))"
proof -
let ?I = "(Π)⇩I"
and ?π = "Φ¯ Π 𝒜 t"
let ?σ = "map (decode_state_at Π 𝒜) [0..<Suc (length ?π)]"
and ?τ = "trace_parallel_plan_strips ?I ?π"
let ?l = "length ?τ "
let ?k = "?l - 1"
show ?thesis
proof (rule ccontr)
assume length_σ_neq_length_τ: "length ?σ ≠ length ?τ"
{
have "length ?σ = length ?π + 1"
by fastforce
moreover have "length ?τ ≤ length ?π + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one
by blast
moreover have "length ?τ < length ?π + 1"
using length_σ_neq_length_τ calculation
by linarith
} note nb⇩1 = this
{
have "0 < length ?τ"
using trace_parallel_plan_strips_not_nil..
then have "length ?τ - 1 < length ?π"
using nb⇩1
by linarith
} note nb⇩2 = this
{
obtain k' where "length ?τ = Suc k'"
using less_imp_Suc_add[OF length_trace_parallel_plan_gt_0]
by blast
hence "?k < length ?π"
using nb⇩2
by blast
} note nb⇩3 = this
{
have "?τ ! ?k = execute_parallel_plan ?I (take ?k ?π)"
using trace_parallel_plan_plan_prefix[of ?k]
length_trace_minus_one_lt_length_trace
by blast
thm encode_problem_parallel_correct_vi[OF assms(1, 2)] nb⇩3
moreover have "(Φ⇩S¯ Π 𝒜 ?k) = ?τ ! ?k"
using encode_problem_parallel_correct_vi[OF assms(1, 2)
length_trace_minus_one_lt_length_trace]..
ultimately have "(Φ⇩S¯ Π 𝒜 ?k) = execute_parallel_plan ?I (take ?k ?π)"
by argo
} note nb⇩4 = this
{
have "are_all_operators_applicable (Φ⇩S¯ Π 𝒜 ?k) (?π ! ?k)"
and "are_all_operator_effects_consistent (?π ! ?k)"
using encode_problem_parallel_correct_ii(1, 2)[OF assms(1, 2)] nb⇩3
by blast+
moreover have "¬are_all_operators_applicable (Φ⇩S¯ Π 𝒜 ?k) (?π ! ?k)"
and "¬are_all_operator_effects_consistent (?π ! ?k)"
using length_trace_parallel_plan_strips_lt_length_plan_plus_one_then[OF nb⇩1]
calculation(1, 2)
unfolding nb⇩3 nb⇩4
by blast+
ultimately have False
by blast
}
thus False.
qed
qed
lemma encode_problem_parallel_correct_x:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
shows "map (decode_state_at Π 𝒜)
[0..<Suc (length (Φ¯ Π 𝒜 t))]
= trace_parallel_plan_strips ((Π)⇩I) (Φ¯ Π 𝒜 t)"
proof -
let ?I = "(Π)⇩I"
and ?π = "Φ¯ Π 𝒜 t"
let ?σ = "map (decode_state_at Π 𝒜) [0..<Suc (length ?π)]"
and ?τ = "trace_parallel_plan_strips ?I ?π"
{
have "length ?τ = length ?σ"
using encode_problem_parallel_correct_vii[OF assms]..
moreover {
fix k
assume k_lt_length_τ: "k < length ?τ"
then have "trace_parallel_plan_strips ((Π)⇩I) (Φ¯ Π 𝒜 t) ! k
= Φ⇩S¯ Π 𝒜 k"
using encode_problem_parallel_correct_vi[OF assms]
by blast
moreover {
have "length ?τ ≤ length ?π + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one
by blast
then have "k < length ?π + 1"
using k_lt_length_τ
by linarith
then have "k < Suc (length ?π) - 0"
by simp
hence "?σ ! k = Φ⇩S¯ Π 𝒜 k"
using nth_map_upt[of k "Suc (length ?π)" 0]
by auto
}
ultimately have "?τ ! k = ?σ ! k"
by argo
}
ultimately have "?τ = ?σ"
using list_eq_iff_nth_eq[of ?τ ?σ]
by blast
}
thus ?thesis
by argo
qed
lemma encode_problem_parallel_correct_xi:
fixes Π:: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
and "ops ∈ set (Φ¯ Π 𝒜 t)"
and "op ∈ set ops"
shows "op ∈ set ((Π)⇩𝒪)"
proof -
let ?π = "Φ¯ Π 𝒜 t"
have "length ?π = t"
using decode_plan_length
by force
moreover obtain k where "k < length ?π" and "ops = ?π ! k"
using in_set_conv_nth[of ops ?π] assms(3)
unfolding calculation
by blast
ultimately show ?thesis
using assms(4) decode_plan_step_element_then(1)
by force
qed
text ‹ To show soundness, we have to prove the following: given the existence of a model
\<^term>‹𝒜› of the basic SATPlan encoding \<^term>‹encode_problem Π t› for a given valid problem \<^term>‹Π›
and hypothesized plan length \<^term>‹t›, the decoded plan \<^term>‹π ≡ Φ¯ Π 𝒜 t› is a parallel solution
for \<^term>‹Π›.
We show this theorem by showing equivalence between the execution trace of the decoded plan and the
sequence of states
@{text[display, indent=4] "σ = map (λ k. Φ⇩S¯ Π 𝒜 k) [0..<Suc (length ?π)]" }
decoded from the model \<^term>‹𝒜›. Let
@{text[display, indent=4] "τ ≡ trace_parallel_plan_strips I π"}
be the trace of \<^term>‹π›. Theorem \ref{isathm:soundness-satplan-encoding} first establishes the
equality \<^term>‹σ = τ› of the decoded state sequence and the trace of \<^term>‹π›.
We can then derive that \<^term>‹G ⊆⇩m last σ› by lemma \ref{isathm:parallel-solution-trace-strips}, i.e. the last
state reached by plan execution (and moreover the last state decoded from the model), satisfies the
goal state \<^term>‹G› defined by the problem. By lemma \ref{isathm:parallel-solution-trace-strips}, we
can conclude that \<^term>‹π› is a solution for \<^term>‹I› and \<^term>‹G›.
Moreover, we show that all operators \<^term>‹op› in all parallel operators \<^term>‹ops ∈ set π›
are also contained in \<^term>‹𝒪›. This is the case because the plan decoding function reverses the
encoding function (which only encodes operators in \<^term>‹𝒪›).
By definition \ref{isadef:parallel-solution-strips} this means that \<^term>‹π› is a parallel solution
for \<^term>‹Π›. Moreover \<^term>‹π› has length \<^term>‹t› as confirmed by lemma
\isaname{decode_plan_length}.
\footnote{This lemma is used in the proof but not shown.} ›
theorem encode_problem_parallel_sound:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ Π t"
shows "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?π = "Φ¯ Π 𝒜 t"
let ?σ = "map (λ k. Φ⇩S¯ Π 𝒜 k) [0..<Suc (length ?π)]"
and ?τ = "trace_parallel_plan_strips ?I ?π"
{
have "?σ = ?τ"
using encode_problem_parallel_correct_x[OF assms].
moreover {
have "length ?π = t"
using decode_plan_length
by auto
then have "?G ⊆⇩m last ?σ"
using decode_state_at_goal_state[OF assms]
by simp
}
ultimately have "((Π)⇩G) ⊆⇩m execute_parallel_plan ((Π)⇩I) (Φ¯ Π 𝒜 t)"
using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace
by auto
}
moreover have "∀ops ∈ set ?π. ∀op ∈ set ops. op ∈ set ((Π)⇩𝒪)"
using encode_problem_parallel_correct_xi[OF assms(1, 2)]
by auto
ultimately show ?thesis
unfolding is_parallel_solution_for_problem_def
unfolding list_all_iff ListMem_iff operators_of_def STRIPS_Representation.operators_of_def
by fastforce
qed
value "stop"
subsection "Completeness"
definition empty_valuation :: "sat_plan_variable valuation" ("𝒜⇩0")
where "empty_valuation ≡ (λ_. False)"
abbreviation valuation_for_state
:: "'variable list
⇒'variable strips_state
⇒ nat
⇒ 'variable
⇒ sat_plan_variable valuation
⇒ sat_plan_variable valuation"
where "valuation_for_state vs s k v 𝒜
≡ 𝒜(State k (index vs v) := (s v = Some True))"
definition valuation_for_state_variables
:: "'variable strips_problem
⇒ 'variable strips_operator list list
⇒ 'variable strips_state list
⇒ sat_plan_variable valuation"
where "valuation_for_state_variables Π π τ ≡ let
t' = length τ
; τ⇩Ω = τ ! (t' - 1)
; vs = variables_of Π
; V⇩1 = { State k (index vs v) | k v. k ∈ {0..<t'} ∧ v ∈ set vs }
; V⇩2 = { State k (index vs v) | k v. k ∈ {t'..(length π + 1)} ∧ v ∈ set vs }
; 𝒜⇩1 = foldr
(λ(k, v) 𝒜. valuation_for_state (variables_of Π) (τ ! k) k v 𝒜)
(List.product [0..<t'] vs)
𝒜⇩0
; 𝒜⇩2 = foldr
(λ(k, v) 𝒜. valuation_for_state (variables_of Π) τ⇩Ω k v 𝒜)
(List.product [t'..<length π + 2] vs)
𝒜⇩0
in override_on (override_on 𝒜⇩0 𝒜⇩1 V⇩1) 𝒜⇩2 V⇩2"
definition valuation_for_operator_variables
:: "'variable strips_problem
⇒ 'variable strips_operator list list
⇒ 'variable strips_state list
⇒ sat_plan_variable valuation"
where "valuation_for_operator_variables Π π τ ≡ let
ops = operators_of Π
; Op = { Operator k (index ops op) | k op. k ∈ {0..<length τ - 1} ∧ op ∈ set ops }
in override_on
𝒜⇩0
(foldr
(λ(k, op) 𝒜. 𝒜(Operator k (index ops op) := True))
(concat (map (λk. map (Pair k) (π ! k)) [0..<length τ - 1]))
𝒜⇩0)
Op"
text ‹ The completeness proof requires that we show that the SATPlan encoding \<^term>‹Φ Π t› of a
problem \<^term>‹Π› has a model \<^term>‹𝒜› in case a solution \<^term>‹π› with length \<^term>‹t› exists.
Since a plan corresponds to a state trace \<^term>‹τ ≡ trace_parallel_plan_strips I π› with
@{text[display, indent=4] "τ ! k = execute_parallel_plan I (take k π)"}
for all \<^term>‹k < length τ› we can construct a valuation \<^term>‹𝒜⇩V› modeling the state sequence in
\<^term>‹τ› by letting
@{text[display, indent=4] "𝒜(State k (index vs v) := (s v = Some True))"}
or all \<^term>‹v ∈ 𝒱› where \<^term>‹s ≡ τ ! k› .
\footnote{It is helpful to remember at this point, that the trace elements of a solution contain
the states reached by plan prefix execution (lemma \ref{isathm:trace-elements-and-plan-prefixes}).}
Similarly to \<^term>‹𝒜⇩V›, we obtain an operator valuation \<^term>‹𝒜⇩O› by defining
@{text[display, indent=4] "𝒜(Operator k (index ops op) := True)"}
for all operators \<^term>‹op ∈ 𝒪› s.t. \<^term>‹op ∈ set (π ! k)› for all \<^term>‹k < length τ - 1›.
The overall valuation for the plan execution \<^term>‹𝒜› can now be constructed by combining the
state variable valuation \<^term>‹𝒜⇩V› and operator valuation \<^term>‹𝒜⇩O›. ›
definition valuation_for_plan
:: "'variable strips_problem
⇒ 'variable strips_operator list list
⇒ sat_plan_variable valuation"
where "valuation_for_plan Π π ≡ let
vs = variables_of Π
; ops = operators_of Π
; τ = trace_parallel_plan_strips (initial_of Π) π
; t = length π
; t' = length τ
; 𝒜⇩V = valuation_for_state_variables Π π τ
; 𝒜⇩O = valuation_for_operator_variables Π π τ
; V = { State k (index vs v)
| k v. k ∈ {0..<t + 1} ∧ v ∈ set vs }
; Op = { Operator k (index ops op)
| k op. k ∈ {0..<t} ∧ op ∈ set ops }
in override_on (override_on 𝒜⇩0 𝒜⇩V V) 𝒜⇩O Op"
lemma model_of_encode_problem_makespan_zero_iff:
"𝒜 ⊨ Φ Π 0 ⟷ 𝒜 ⊨ Φ⇩I Π ❙∧ (Φ⇩G Π) 0"
proof -
have "encode_operators Π 0 = ❙¬⊥ ❙∧ ❙¬⊥"
unfolding encode_operators_def encode_all_operator_effects_def
encode_all_operator_preconditions_def
by simp
moreover have "encode_all_frame_axioms Π 0 = ❙¬⊥"
unfolding encode_all_frame_axioms_def
by simp
ultimately show ?thesis
unfolding encode_problem_def SAT_Plan_Base.encode_problem_def encode_initial_state_def
encode_goal_state_def
by simp
qed
lemma empty_valution_is_False[simp]: "𝒜⇩0 v = False"
unfolding empty_valuation_def..
lemma model_initial_state_set_valuations:
assumes "is_valid_problem_strips Π"
shows "set (map (λv. case ((Π)⇩I) v of Some b
⇒ 𝒜⇩0(State 0 (index (strips_problem.variables_of Π) v) := b)
| _ ⇒ 𝒜⇩0)
(strips_problem.variables_of Π))
= { 𝒜⇩0(State 0 (index (strips_problem.variables_of Π) v) := the (((Π)⇩I) v))
| v. v ∈ set ((Π)⇩𝒱) }"
proof -
let ?I = "(Π)⇩I"
and ?vs = "strips_problem.variables_of Π"
let ?f = "λv. case ((Π)⇩I) v of Some b
⇒ 𝒜⇩0(State 0 (index ?vs v) := b) | _ ⇒ 𝒜⇩0"
and ?g = "λv. 𝒜⇩0(State 0 (index ?vs v) := the (?I v))"
let ?𝒜s = "map ?f ?vs"
have nb⇩1: "dom ?I = set ((Π)⇩𝒱)"
using is_valid_problem_strips_initial_of_dom assms
by fastforce
{
{
fix v
assume "v ∈ dom ?I"
hence "?f v = ?g v"
using nb⇩1
by fastforce
}
hence "?f ` set ((Π)⇩𝒱) = ?g ` set ((Π)⇩𝒱)"
using nb⇩1
by force
}
then have "set ?𝒜s = ?g ` set ((Π)⇩𝒱)"
unfolding set_map
by simp
thus ?thesis
by blast
qed
lemma valuation_of_state_variable_implies_lit_semantics_if:
assumes "v ∈ dom S"
and "𝒜 (State k (index vs v)) = the (S v)"
shows "lit_semantics 𝒜 (literal_formula_to_literal (encode_state_variable k (index vs v) (S v)))"
proof -
let ?L = "literal_formula_to_literal (encode_state_variable k (index vs v) (S v))"
consider (True) "S v = Some True"
| (False) "S v = Some False"
using assms(1)
by fastforce
thus ?thesis
unfolding encode_state_variable_def
using assms(2)
by (cases, force+)
qed
lemma foldr_fun_upd:
assumes "inj_on f (set xs)"
and "x ∈ set xs"
shows "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 (f x) = g x"
using assms
proof (induction xs)
case (Cons a xs)
then show ?case
proof (cases "xs = []")
case True
then have "x = a"
using Cons.prems(2)
by simp
thus ?thesis
by simp
next
case False
thus ?thesis
proof (cases "a = x")
next
case False
{
from False
have "x ∈ set xs"
using Cons.prems(2)
by simp
moreover have "inj_on f (set xs)"
using Cons.prems(1)
by fastforce
ultimately have "(foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) (f x) = g x"
using Cons.IH
by blast
} moreover {
have "f a ≠ f x"
using Cons.prems False
by force
moreover have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜
= (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜)(f a := g a)"
by simp
ultimately have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜 (f x)
= (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) (f x)"
unfolding fun_upd_def
by presburger
} ultimately show ?thesis
by argo
qed simp
qed
qed fastforce
lemma foldr_fun_no_upd:
assumes "inj_on f (set xs)"
and "y ∉ f ` set xs"
shows "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 y = 𝒜 y"
using assms
proof (induction xs)
case (Cons a xs)
{
have "inj_on f (set xs)" and "y ∉ f ` set xs"
using Cons.prems
by (fastforce, simp)
hence "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 y = 𝒜 y"
using Cons.IH
by blast
}
moreover {
have "f a ≠ y"
using Cons.prems(2)
by auto
moreover have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜
= (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜)(f a := g a)"
by simp
ultimately have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜 y
= (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) y"
unfolding fun_upd_def
by presburger
}
ultimately show ?case
by argo
qed simp
lemma encode_problem_parallel_complete_i:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
"∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)
∧ (¬𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ ((trace_parallel_plan_strips ((Π)⇩I) π ! k) v ≠ Some True))"
shows "𝒜 ⊨ Φ⇩I Π"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?Φ⇩I = "Φ⇩I Π"
let ?τ = "trace_parallel_plan_strips ?I π"
{
fix C
assume "C ∈ cnf ?Φ⇩I"
then obtain v
where v_in_set_vs: "v ∈ set ?vs"
and C_is: "C = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }"
using cnf_of_encode_initial_state_set_ii[OF assms(1)]
by auto
{
have "0 < length ?τ"
using trace_parallel_plan_strips_not_nil
by blast
then have "𝒜 (State 0 (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! 0) v = Some True"
and "¬𝒜 (State 0 (index (strips_problem.variables_of Π) v))
⟷ ((trace_parallel_plan_strips ((Π)⇩I) π ! 0) v ≠ Some True)"
using assms(3)
by (presburger+)
} note nb = this
{
let ?L = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v))"
have τ_0_is: "?τ ! 0 = ?I"
using trace_parallel_plan_strips_head_is_initial_state
by blast
have v_in_dom_I: "v ∈ dom ?I"
using is_valid_problem_strips_initial_of_dom assms(1) v_in_set_vs
by fastforce
then consider (I_v_is_Some_True) "?I v = Some True"
| (I_v_is_Some_False) "?I v = Some False"
by fastforce
hence "lit_semantics 𝒜 ?L"
unfolding encode_state_variable_def
using assms(3) τ_0_is nb
by (cases, force+)
}
hence "clause_semantics 𝒜 C"
unfolding clause_semantics_def C_is
by blast
}
thus ?thesis
using is_cnf_encode_initial_state[OF assms(1)] is_nnf_cnf cnf_semantics
unfolding cnf_semantics_def
by blast
qed
lemma encode_problem_parallel_complete_ii:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
and "∀v l. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) ∧ l < length π + 1
⟶ 𝒜 (State l (index (strips_problem.variables_of Π) v))
= 𝒜 (State (length (trace_parallel_plan_strips ((Π)⇩I) π) - 1)
(index (strips_problem.variables_of Π) v))"
shows "𝒜 ⊨ (Φ⇩G Π)(length π)"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?Φ⇩I = "Φ⇩I Π"
and ?t = "length π"
and ?Φ⇩G = "(Φ⇩G Π) (length π)"
let ?τ = "trace_parallel_plan_strips ?I π"
let ?t' = "length ?τ"
{
fix v
assume G_of_v_is_not_None: "?G v ≠ None"
have "?G ⊆⇩m last ?τ"
using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace assms(2)
by blast
also have "… = ?τ ! (?t' - 1)"
using last_conv_nth[OF trace_parallel_plan_strips_not_nil].
finally have "?G ⊆⇩m ?τ ! (?t' - 1)"
by argo
hence "(?τ ! (?t' - 1)) v = ?G v"
using G_of_v_is_not_None
unfolding map_le_def
by force
} note nb⇩1 = this
{
fix v
assume G_of_v_is_not_None: "?G v ≠ None"
hence "𝒜 (State ?t (index ?vs v)) ⟷ ?G v = Some True"
proof (cases "?t' = ?t + 1")
case True
moreover have "?t < ?t'"
using calculation
by fastforce
moreover have "𝒜 (State ?t (index ?vs v)) ⟷ (?τ ! ?t) v = Some True"
using assms(3) calculation(2)
by blast
ultimately show ?thesis
using nb⇩1[OF G_of_v_is_not_None]
by force
next
case False
{
have "?t' < ?t + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one False
le_neq_implies_less
by blast
moreover have "𝒜 (State ?t (index ?vs v)) = 𝒜 (State (?t' - 1) (index ?vs v))"
using assms(4) calculation
by simp
moreover have "?t' - 1 < ?t'"
using trace_parallel_plan_strips_not_nil length_greater_0_conv[of ?τ]
less_diff_conv2[of 1 ?t' ?t']
by force
moreover have "𝒜 (State (?t' - 1) (index ?vs v)) ⟷ (?τ ! (?t' - 1)) v = Some True"
using assms(3) calculation(3)
by blast
ultimately have "𝒜 (State ?t (index ?vs v)) ⟷ (?τ ! (?t' - 1)) v = Some True"
by blast
}
thus ?thesis
using nb⇩1[OF G_of_v_is_not_None]
by presburger
qed
} note nb⇩2 = this
{
fix C
assume C_in_cnf_of_Φ⇩G: "C ∈ cnf ?Φ⇩G"
moreover obtain v
where "v ∈ set ?vs"
and G_of_v_is_not_None: "?G v ≠ None"
and C_is: "C = { literal_formula_to_literal (encode_state_variable ?t (index ?vs v)
(?G v)) }"
using cnf_of_encode_goal_state_set_ii[OF assms(1)] calculation
by auto
consider (G_of_v_is_Some_True) "?G v = Some True"
| (G_of_v_is_Some_False) "?G v = Some False"
using G_of_v_is_not_None
by fastforce
then have "clause_semantics 𝒜 C"
using nb⇩2 C_is
unfolding clause_semantics_def encode_state_variable_def
by (cases, force+)
}
thus ?thesis
using cnf_semantics[OF is_nnf_cnf[OF encode_goal_state_is_cnf[OF assms(1)]]]
unfolding cnf_semantics_def
by blast
qed
lemma encode_problem_parallel_complete_iii_a:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
and "C ∈ cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) (length π))"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀l op. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) - 1 ∧ l < length π
⟶ ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
shows "clause_semantics 𝒜 C"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
and ?t = "length π"
let ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
obtain k op
where k_and_op_are: "(k, op) ∈ ({0..<?t} × set ((Π)⇩𝒪))"
and "C ∈ (⋃v ∈ set (precondition_of op). {{ (Operator k (index ?ops op))¯
, (State k (index ?vs v))⇧+ }})"
using cnf_of_encode_all_operator_preconditions_structure assms(3)
UN_E[of C ]
by auto
then obtain v
where v_in_preconditions_of_op: "v ∈ set (precondition_of op)"
and C_is: "C = { (Operator k (index ?ops op))¯, (State k (index ?vs v))⇧+ }"
by blast
thus ?thesis
proof (cases "k < length ?τ - 1")
case k_lt_length_τ_minus_one: True
thus ?thesis
proof (cases "op ∈ set (π ! k)")
case True
{
have "are_all_operators_applicable (?τ ! k) (π ! k)"
using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
by blast
then have "(?τ ! k) v = Some True"
using are_all_operators_applicable_set v_in_preconditions_of_op True
by fast
hence "𝒜 (State k (index ?vs v))"
using assms(6) k_lt_length_τ_minus_one
by force
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(4) k_lt_length_τ_minus_one
by blast
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
next
case False
then have "k ≥ length ?τ - 1" "k < ?t"
using k_and_op_are
by(force, simp)
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(5)
by blast
thus ?thesis
unfolding clause_semantics_def
using C_is
by fastforce
qed
qed
lemma encode_problem_parallel_complete_iii_b:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
and "C ∈ cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) (length π))"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀l op. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) - 1 ∧ l < length π
⟶ ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
shows "clause_semantics 𝒜 C"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?vs = "strips_problem.variables_of Π"
and ?t = "length π"
let ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?A = "(⋃(k, op) ∈ {0..<?t} × set ((Π)⇩𝒪).
⋃v ∈ set (add_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+ }})"
and ?B = "(⋃(k, op) ∈ {0..<?t} × set ((Π)⇩𝒪).
⋃v ∈ set (delete_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
consider (C_in_A) "C ∈ ?A"
| (C_in_B) "C ∈ ?B"
using Un_iff[of C ?A ?B] cnf_of_encode_all_operator_effects_structure assms(3)
by (metis C_in_A C_in_B)
thus ?thesis
proof (cases)
case C_in_A
then obtain k op
where k_and_op_are: "(k, op) ∈ {0..<?t} × set((Π)⇩𝒪)"
and "C ∈ (⋃v ∈ set (add_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+ }})"
by blast
then obtain v where v_in_add_effects_of_op: "v ∈ set (add_effects_of op)"
and C_is: "C = { (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))⇧+ }"
by blast
thus ?thesis
proof (cases "k < length ?τ - 1")
case k_lt_length_τ_minus_one: True
thus ?thesis
proof (cases "op ∈ set (π ! k)")
case True
{
then have "are_all_operators_applicable (?τ ! k) (π ! k)"
and "are_all_operator_effects_consistent (π ! k)"
using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
by blast+
hence "execute_parallel_operator (?τ ! k) (π ! k) v = Some True"
using execute_parallel_operator_positive_effect_if[
OF _ _ True v_in_add_effects_of_op, of "?τ ! k"]
by blast
}
then have τ_Suc_k_is_Some_True: "(?τ ! Suc k) v = Some True"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
by argo
have "𝒜 (State (Suc k) (index ?vs v))"
using assms(6) k_lt_length_τ_minus_one τ_Suc_k_is_Some_True
by fastforce
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(4) k_lt_length_τ_minus_one
by blast
thus ?thesis
using C_is
unfolding clause_semantics_def
by force
qed
next
case False
then have "k ≥ length ?τ - 1" and "k < ?t"
using k_and_op_are
by auto
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(5)
by blast
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
next
case C_in_B
then obtain k op
where k_and_op_are: "(k, op) ∈ {0..<?t} × set ((Π)⇩𝒪)"
and "C ∈ (⋃v ∈ set (delete_effects_of op).
{{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
by blast
then obtain v where v_in_delete_effects_of_op: "v ∈ set (delete_effects_of op)"
and C_is: "C = { (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }"
by blast
thus ?thesis
proof (cases "k < length ?τ - 1")
case k_lt_length_τ_minus_one: True
thus ?thesis
proof (cases "op ∈ set (π ! k)")
case True
{
then have "are_all_operators_applicable (?τ ! k) (π ! k)"
and "are_all_operator_effects_consistent (π ! k)"
using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
by blast+
hence "execute_parallel_operator (?τ ! k) (π ! k) v = Some False"
using execute_parallel_operator_negative_effect_if[
OF _ _ True v_in_delete_effects_of_op, of "?τ ! k"]
by blast
}
then have τ_Suc_k_is_Some_True: "(?τ ! Suc k) v = Some False"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
by argo
have "¬𝒜 (State (Suc k) (index ?vs v))"
using assms(6) k_lt_length_τ_minus_one τ_Suc_k_is_Some_True
by fastforce
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(4) k_lt_length_τ_minus_one
by blast
thus ?thesis
using C_is
unfolding clause_semantics_def
by force
qed
next
case False
then have "k ≥ length ?τ - 1" and "k < ?t"
using k_and_op_are
by auto
then have "¬𝒜 (Operator k (index ?ops op))"
using assms(5)
by blast
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
qed
qed
lemma encode_problem_parallel_complete_iii:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "(Π)⇩G ⊆⇩m execute_parallel_plan ((Π)⇩I) π"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀l op. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) - 1 ∧ l < length π
⟶ ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
shows "𝒜 ⊨ encode_operators Π (length π)"
proof -
let ?t = "length π"
and ?ops = "strips_problem.operators_of Π"
let ?Φ⇩O = "encode_operators Π ?t"
and ?Φ⇩P = "encode_all_operator_preconditions Π ?ops?t"
and ?Φ⇩E = "encode_all_operator_effects Π ?ops ?t"
{
fix C
assume "C ∈ cnf ?Φ⇩O"
then consider (C_in_precondition_encoding) "C ∈ cnf ?Φ⇩P"
| (C_in_effect_encoding) "C ∈ cnf ?Φ⇩E"
using cnf_of_operator_encoding_structure
by blast
hence "clause_semantics 𝒜 C"
proof (cases)
case C_in_precondition_encoding
thus ?thesis
using encode_problem_parallel_complete_iii_a[OF assms(1, 2) _ assms(3, 4, 5)]
by blast
next
case C_in_effect_encoding
thus ?thesis
using encode_problem_parallel_complete_iii_b[OF assms(1, 2) _ assms(3, 4, 5)]
by blast
qed
}
thus ?thesis
using encode_operators_is_cnf[OF assms(1)] is_nnf_cnf cnf_semantics
unfolding cnf_semantics_def
by blast
qed
lemma encode_problem_parallel_complete_iv_a:
fixes Π :: "'a strips_problem"
assumes "STRIPS_Semantics.is_parallel_solution_for_problem Π π"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
and "∀v l. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) ∧ l < length π + 1
⟶ 𝒜 (State l (index (strips_problem.variables_of Π) v))
= 𝒜 (State
(length (trace_parallel_plan_strips ((Π)⇩I) π) - 1)
(index (strips_problem.variables_of Π) v))"
and "C ∈ ⋃ (⋃(k, v) ∈ {0..<length π} × set ((Π)⇩𝒱).
{{{ (State k (index (strips_problem.variables_of Π) v))⇧+
, (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
∪ { (Operator k (index (strips_problem.operators_of Π) op))⇧+
|op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})"
shows "clause_semantics 𝒜 C"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
let ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?A = "(⋃(k, v) ∈ {0..<?t} × set ?vs.
{{{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+ |op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}})"
{
obtain C' where "C' ∈ ?A" and C_in_C': "C ∈ C'"
using Union_iff assms(5)
by auto
then obtain k v
where "(k, v) ∈ {0..<?t} × set ?vs"
and "C' ∈ {{{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+ |op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }}}"
using UN_E
by blast
hence "∃k v.
k ∈ {0..<?t}
∧ v ∈ set ?vs
∧ C = { (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+ |op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
using C_in_C'
by blast
}
then obtain k v
where k_in: "k ∈ {0..<?t}"
and v_in_vs: "v ∈ set ?vs"
and C_is: "C = { (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+ |op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
by blast
show ?thesis
proof (cases "k < length ?τ - 1")
case k_lt_length_τ_minus_one: True
then have k_lt_t: "k < ?t"
using k_in
by force
have all_operators_applicable: "are_all_operators_applicable (?τ ! k) (π ! k)"
and all_operator_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
by simp+
then consider (A) "∃op ∈ set (π ! k). v ∈ set (add_effects_of op)"
| (B) "∃op ∈ set (π ! k). v ∈ set (delete_effects_of op)"
| (C) "∀op ∈ set (π ! k). v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)"
by blast
thus ?thesis
proof (cases)
case A
moreover obtain op
where op_in_π⇩k: "op ∈ set (π ! k)"
and v_is_add_effect: "v ∈ set (add_effects_of op)"
using A
by blast
moreover {
have "(π ! k) ∈ set π"
using k_lt_t
by simp
hence "op ∈ set ?ops"
using is_parallel_solution_for_problem_operator_set[OF assms(1) _ op_in_π⇩k]
by blast
}
ultimately have "(Operator k (index ?ops op))⇧+
∈ { (Operator k (index ?ops op))⇧+ | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op) }"
using v_is_add_effect
by blast
then have "(Operator k (index ?ops op))⇧+ ∈ C"
using C_is
by auto
moreover have "𝒜 (Operator k (index ?ops op))"
using assms(2) k_lt_length_τ_minus_one op_in_π⇩k
by blast
ultimately show ?thesis
unfolding clause_semantics_def
by force
next
case B
then obtain op
where op_in_π⇩k: "op ∈ set (π ! k)"
and v_is_delete_effect: "v ∈ set (delete_effects_of op)"..
then have "¬(∃op ∈ set (π ! k). v ∈ set (add_effects_of op))"
using all_operator_effects_consistent are_all_operator_effects_consistent_set
by fast
then have "execute_parallel_operator (?τ ! k) (π ! k) v
= Some False"
using execute_parallel_operator_negative_effect_if[OF all_operators_applicable
all_operator_effects_consistent op_in_π⇩k v_is_delete_effect]
by blast
moreover have "(?τ ! Suc k) v = execute_parallel_operator (?τ ! k) (π ! k) v"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
by simp
ultimately have "¬𝒜 (State (Suc k) (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by simp
thus ?thesis
using C_is
unfolding clause_semantics_def
by simp
next
case C
show ?thesis
proof (cases "(?τ ! k) v = Some True")
case True
then have "𝒜 (State k (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by force
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
{
have "(?τ ! Suc k) = execute_parallel_operator (?τ ! k) (π ! k)"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
then have "(?τ ! Suc k) v = (?τ ! k) v"
using execute_parallel_operator_no_effect_if C
by fastforce
hence "(?τ ! Suc k) v ≠ Some True"
using False
by argo
}
then have "¬𝒜 (State (Suc k) (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by auto
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
qed
next
case k_gte_length_τ_minus_one: False
show ?thesis
proof (cases "𝒜 (State (length ?τ - 1) (index ?vs v))")
case True
{
have "𝒜 (State k (index ?vs v)) = 𝒜 (State (length ?τ - 1) (index ?vs v))"
proof (cases "k = length ?τ - 1")
case False
then have "length ?τ ≤ k" and "k < ?t + 1"
using k_gte_length_τ_minus_one k_in
by fastforce+
thus ?thesis
using assms(4)
by blast
qed blast
hence "𝒜 (State k (index ?vs v))"
using True
by blast
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by simp
next
case False
{
have "length ?τ ≤ Suc k" and "Suc k < ?t + 1"
using k_gte_length_τ_minus_one k_in
by fastforce+
then have "𝒜 (State (Suc k) (index ?vs v)) = 𝒜 (State (length ?τ - 1) (index ?vs v))"
using assms(4)
by blast
hence "¬𝒜 (State (Suc k) (index ?vs v))"
using False
by blast
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
qed
qed
lemma encode_problem_parallel_complete_iv_b:
fixes Π :: "'a strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
and "∀v l. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) ∧ l < length π + 1
⟶ 𝒜 (State l (index (strips_problem.variables_of Π) v))
= 𝒜 (State
(length (trace_parallel_plan_strips ((Π)⇩I) π) - 1)
(index (strips_problem.variables_of Π) v))"
and "C ∈ ⋃ (⋃(k, v) ∈ {0..<length π} × set ((Π)⇩𝒱).
{{{ (State k (index (strips_problem.variables_of Π) v))¯
, (State (Suc k) (index (strips_problem.variables_of Π) v))⇧+ }
∪ { (Operator k (index (strips_problem.operators_of Π) op))⇧+
|op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }}})"
shows "clause_semantics 𝒜 C"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
let ?τ = "trace_parallel_plan_strips (initial_of Π) π"
let ?A = "(⋃(k, v) ∈ {0..<?t} × set ?vs.
{{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }}})"
{
obtain C' where "C' ∈ ?A" and C_in_C': "C ∈ C'"
using Union_iff assms(5)
by auto
then obtain k v
where "(k, v) ∈ {0..<?t} × set ?vs"
and "C' ∈ {{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+ |op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }}}"
using UN_E
by fastforce
hence "∃k v.
k ∈ {0..<?t}
∧ v ∈ set ?vs
∧ C = { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }"
using C_in_C'
by auto
}
then obtain k v
where k_in: "k ∈ {0..<?t}"
and v_in_vs: "v ∈ set ((Π)⇩𝒱)"
and C_is: "C = { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }"
by auto
show ?thesis
proof (cases "k < length ?τ - 1")
case k_lt_length_τ_minus_one: True
then have k_lt_t: "k < ?t"
using k_in
by force
have all_operators_applicable: "are_all_operators_applicable (?τ ! k) (π ! k)"
and all_operator_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
by simp+
then consider (A) "∃op ∈ set (π ! k). v ∈ set (delete_effects_of op)"
| (B) "∃op ∈ set (π ! k). v ∈ set (add_effects_of op)"
| (C) "∀op ∈ set (π ! k). v ∉ set (add_effects_of op) ∧ v ∉ set (delete_effects_of op)"
by blast
thus ?thesis
proof (cases)
case A
moreover obtain op
where op_in_π⇩k: "op ∈ set (π ! k)"
and v_is_delete_effect: "v ∈ set (delete_effects_of op)"
using A
by blast
moreover {
have "(π ! k) ∈ set π"
using k_lt_t
by simp
hence "op ∈ set ?ops"
using is_parallel_solution_for_problem_operator_set[OF assms(1) _ op_in_π⇩k]
by auto
}
ultimately have "(Operator k (index ?ops op))⇧+
∈ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op) }"
using v_is_delete_effect
by blast
then have "(Operator k (index ?ops op))⇧+ ∈ C"
using C_is
by auto
moreover have "𝒜 (Operator k (index ?ops op))"
using assms(2) k_lt_length_τ_minus_one op_in_π⇩k
by blast
ultimately show ?thesis
unfolding clause_semantics_def
by force
next
case B
then obtain op
where op_in_π⇩k: "op ∈ set (π ! k)"
and v_is_add_effect: "v ∈ set (add_effects_of op)"..
then have "¬(∃op ∈ set (π ! k). v ∈ set (delete_effects_of op))"
using all_operator_effects_consistent are_all_operator_effects_consistent_set
by fast
then have "execute_parallel_operator (?τ ! k) (π ! k) v = Some True"
using execute_parallel_operator_positive_effect_if[OF all_operators_applicable
all_operator_effects_consistent op_in_π⇩k v_is_add_effect]
by blast
moreover have "(?τ ! Suc k) v = execute_parallel_operator (?τ ! k) (π ! k) v"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
by simp
ultimately have "𝒜 (State (Suc k) (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by simp
thus ?thesis
using C_is
unfolding clause_semantics_def
by simp
next
case C
show ?thesis
proof (cases "(?τ ! k) v = Some True")
case True
{
have "(?τ ! Suc k) = execute_parallel_operator (?τ ! k) (π ! k)"
using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
then have "(?τ ! Suc k) v = (?τ ! k) v"
using execute_parallel_operator_no_effect_if C
by fastforce
then have "(?τ ! Suc k) v = Some True"
using True
by argo
hence "𝒜 (State (Suc k) (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by fastforce
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
then have "¬𝒜 (State k (index ?vs v))"
using assms(3) k_lt_length_τ_minus_one
by simp
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
qed
qed
next
case k_gte_length_τ_minus_one: False
show ?thesis
proof (cases "𝒜 (State (length ?τ - 1) (index ?vs v))")
case True
{
have "length ?τ ≤ Suc k" and "Suc k < ?t + 1"
using k_gte_length_τ_minus_one k_in
by fastforce+
then have "𝒜 (State (Suc k) (index ?vs v)) = 𝒜 (State (length ?τ - 1) (index ?vs v))"
using assms(4)
by blast
hence "𝒜 (State (Suc k) (index ?vs v))"
using True
by blast
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by fastforce
next
case False
{
have "𝒜 (State k (index ?vs v)) = 𝒜 (State (length ?τ - 1) (index ?vs v))"
proof (cases "k = length ?τ - 1")
case False
then have "length ?τ ≤ k" and "k < ?t + 1"
using k_gte_length_τ_minus_one k_in
by fastforce+
thus ?thesis
using assms(4)
by blast
qed blast
hence "¬𝒜 (State k (index ?vs v))"
using False
by blast
}
thus ?thesis
using C_is
unfolding clause_semantics_def
by simp
qed
qed
qed
lemma encode_problem_parallel_complete_iv:
fixes Π::"'a strips_problem"
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "∀k op. k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1
⟶ 𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op ∈ set (π ! k))"
and "∀v k. k < length (trace_parallel_plan_strips ((Π)⇩I) π)
⟶ (𝒜 (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True)"
and "∀v l. l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) ∧ l < length π + 1
⟶ 𝒜 (State l (index (strips_problem.variables_of Π) v))
= 𝒜 (State
(length (trace_parallel_plan_strips ((Π)⇩I) π) - 1)
(index (strips_problem.variables_of Π) v))"
shows "𝒜 ⊨ encode_all_frame_axioms Π (length π)"
proof -
let ?Φ⇩F = "encode_all_frame_axioms Π (length π)"
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
let ?A = "⋃ (⋃(k, v) ∈ {0..<?t} × set ((Π)⇩𝒱).
{{{ (State k (index ?vs v))⇧+, (State (Suc k) (index ?vs v))¯ }
∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (add_effects_of op) }}})"
and ?B = "⋃ (⋃(k, v) ∈ {0..<?t} × set ((Π)⇩𝒱).
{{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))⇧+ }
∪ { (Operator k (index ?ops op))⇧+
| op. op ∈ set ((Π)⇩𝒪) ∧ v ∈ set (delete_effects_of op) }}})"
have cnf_Φ⇩F_is_A_union_B: "cnf ?Φ⇩F = ?A ∪ ?B"
using cnf_of_encode_all_frame_axioms_structure
by (simp add: cnf_of_encode_all_frame_axioms_structure)
{
fix C
assume "C ∈ cnf ?Φ⇩F"
then consider (C_in_A) "C ∈ ?A"
| (C_in_B) "C ∈ ?B"
using Un_iff[of C ?A ?B] cnf_Φ⇩F_is_A_union_B
by argo
hence "clause_semantics 𝒜 C"
proof (cases)
case C_in_A
then show ?thesis
using encode_problem_parallel_complete_iv_a[OF assms(2, 3, 4, 5) C_in_A]
by blast
next
case C_in_B
then show ?thesis
using encode_problem_parallel_complete_iv_b[OF assms(2, 3, 4, 5) C_in_B]
by blast
qed
}
thus ?thesis
using encode_frame_axioms_is_cnf is_nnf_cnf cnf_semantics
unfolding cnf_semantics_def
by blast
qed
lemma valuation_for_operator_variables_is:
fixes Π :: "'a strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1"
and "op ∈ set ((Π)⇩𝒪)"
shows "valuation_for_operator_variables Π π (trace_parallel_plan_strips ((Π)⇩I) π)
(Operator k (index (strips_problem.operators_of Π) op))
= (op ∈ set (π ! k))"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?v = "Operator k (index ?ops op)"
and ?Op = "{ Operator k (index ?ops op)
| k op. k ∈ {0..<length ?τ - 1} ∧ op ∈ set ((Π)⇩𝒪) }"
let ?l = "concat (map (λk. map (Pair k) (π ! k)) [0..<length ?τ - 1])"
and ?f = "λx. Operator (fst x) (index ?ops (snd x))"
have k_in: "k ∈ {0..<length ?τ - 1}"
using assms(2)
by fastforce
{
{
fix k k' op op'
assume k_op_in: "(k, op) ∈ set ?l" and k'_op'_in: "(k', op') ∈ set ?l"
have "Operator k (index ?ops op) = Operator k' (index ?ops op') ⟷ (k, op) = (k', op')"
proof (rule iffI)
assume index_op_is_index_op': "Operator k (index ?ops op) = Operator k' (index ?ops op')"
then have k_is_k': "k = k'"
by fast
moreover {
have k'_lt: "k' < length ?τ - 1"
using k'_op'_in
by fastforce
have op_in: "op ∈ set (π ! k)"
using k_op_in
by force
then have op'_in: "op' ∈ set (π ! k)"
using k'_op'_in k_is_k'
by auto
{
have length_τ_gt_1: "length ?τ > 1"
using assms(2)
by linarith
have "length ?τ - Suc 0 ≤ length π + 1 - Suc 0"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one
using diff_le_mono
by blast
then have "length ?τ - 1 ≤ length π"
by fastforce
then have "k' < length π"
using length_τ_gt_1 k'_lt
by linarith
hence "π ! k' ∈ set π"
by simp
}
moreover have "op ∈ set ?ops" and "op' ∈ set ?ops"
using is_parallel_solution_for_problem_operator_set[OF assms(1)] op_in op'_in k_is_k'
calculation
by auto
ultimately have "op = op'"
using index_op_is_index_op'
by force
}
ultimately show "(k, op) = (k', op')"
by blast
qed fast
}
hence "inj_on ?f (set ?l)"
unfolding inj_on_def fst_def snd_def
by fast
} note inj_on_f_set_l = this
{
have "set ?l = ⋃ (set ` set (map (λk. map (Pair k) (π ! k)) [0..<length ?τ - 1]))"
using set_concat
by metis
also have "… = ⋃ (set ` (λk. map (Pair k) (π ! k)) ` {0..<length ?τ - 1})"
by force
also have "… = ⋃ ((λk. (Pair k) ` set (π ! k)) ` {0..<length ?τ - 1})"
by force
also have "… = ⋃((λk. { (k, op) | op. op ∈ set (π ! k) }) ` {0..<length ?τ - 1})"
by blast
also have "… = ⋃({{ (k, op) } | k op. k ∈ {0..<length ?τ - 1} ∧ op ∈ set (π ! k) })"
by blast
finally have "set ?l = ⋃((λ(k, op). { (k, op) })
` { (k, op). k ∈ {0..<length ?τ - 1} ∧ op ∈ set (π ! k) })"
using setcompr_eq_image[of "λ(k, op). { (k, op) }" _]
by auto
} note set_l_is = this
{
have "Operator k (index ?ops op) ∈ ?Op"
using assms(3) k_in
by blast
hence "valuation_for_operator_variables Π π ?τ ?v
= foldr (λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True)) ?l 𝒜⇩0 ?v"
unfolding valuation_for_operator_variables_def override_on_def Let_def
by auto
} note nb = this
show ?thesis
proof (cases "op ∈ set (π ! k)")
case True
moreover have k_op_in: "(k, op) ∈ set ?l"
using set_l_is k_in calculation
by blast
moreover {
let ?g = "λ_. True"
thm foldr_fun_upd[OF inj_on_f_set_l k_op_in]
have "?v = Operator (fst (k, op)) (index ?ops (snd (k, op)))"
by simp
moreover have "(λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True))
= (λx 𝒜. 𝒜(Operator (fst x) (index ?ops (snd x)) := True))"
by fastforce
moreover have "foldr (λx 𝒜. 𝒜(Operator (fst x) (index ?ops (snd x)) := ?g x))
?l 𝒜⇩0 (Operator (fst (k, op)) (index ?ops (snd (k, op)))) = True"
unfolding foldr_fun_upd[OF inj_on_f_set_l k_op_in]..
ultimately have "valuation_for_operator_variables Π π ?τ ?v = True"
using nb
by argo
}
thus ?thesis
using True
by blast
next
case False
{
have "(k, op) ∉ set ?l"
using False set_l_is
by fast
moreover {
fix k' op'
assume "(k', op') ∈ set ?l"
and "?f (k', op') = ?f (k, op)"
hence "(k', op') = (k, op)"
using inj_on_f_set_l assms(3)
by simp
}
ultimately have "Operator k (index ?ops op) ∉ ?f ` set ?l"
using image_iff
by force
} note operator_not_in_f_image_set_l = this
{
have "𝒜⇩0 (Operator k (index ?ops op)) = False"
by simp
moreover have "(λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True))
= (λx 𝒜. 𝒜(Operator (fst x) (index ?ops (snd x)) := True))"
by fastforce
ultimately have "foldr (λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True)) ?l 𝒜⇩0 ?v = False"
using foldr_fun_no_upd[OF inj_on_f_set_l operator_not_in_f_image_set_l, of "λ_. True" 𝒜⇩0]
by presburger
}
thus ?thesis
using nb False
by blast
qed
qed
lemma encode_problem_parallel_complete_vi_a:
fixes Π :: "'a strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1"
shows "valuation_for_plan Π π (Operator k (index (strips_problem.operators_of Π) op))
= (op ∈ set (π ! k))"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?𝒜⇩π = "valuation_for_plan Π π"
and ?𝒜⇩O = "valuation_for_operator_variables Π π ?τ"
and ?Op = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t} ∧ op ∈ set ?ops }"
and ?V = "{ State k (index ?vs v) | k v. k ∈ {0..<?t + 1} ∧ v ∈ set ?vs }"
and ?v = "Operator k (index ?ops op)"
{
have "length ?τ ≤ length π + 1"
using length_trace_parallel_plan_strips_lte_length_plan_plus_one.
then have "length ?τ - 1 ≤ length π"
by simp
then have "k < ?t"
using assms
by fastforce
} note k_lt_length_π = this
show ?thesis
proof (cases "op ∈ set ((Π)⇩𝒪)")
case True
{
have "?v ∈ ?Op"
using k_lt_length_π True
by auto
hence "?𝒜⇩π ?v = ?𝒜⇩O ?v"
unfolding valuation_for_plan_def override_on_def Let_def
by force
}
then show ?thesis
using valuation_for_operator_variables_is[OF assms(1, 2) True]
by blast
next
case False
{
{
have "?Op = (λ(k, op). Operator k (index ?ops op)) ` ({0..<?t} × set ?ops)"
by fast
moreover have "¬index ?ops op < length ?ops"
using False
by simp
ultimately have "?v ∉ ?Op"
by fastforce
}
moreover have "?v ∉ ?V"
by force
ultimately have "?𝒜⇩π ?v = 𝒜⇩0 ?v"
unfolding valuation_for_plan_def override_on_def
by metis
hence "¬?𝒜⇩π ?v"
unfolding empty_valuation_def
by blast
}
moreover have "(π ! k) ∈ set π"
using k_lt_length_π
by simp
moreover have "op ∉ set (π ! k)"
using is_parallel_solution_for_problem_operator_set[OF assms(1) calculation(2)] False
by blast
ultimately show ?thesis
by blast
qed
qed
lemma encode_problem_parallel_complete_vi_b:
fixes Π :: "'a strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π) - 1"
and "l < length π"
shows "¬valuation_for_plan Π π (Operator l (index (strips_problem.operators_of Π) op))"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?𝒜⇩π = "valuation_for_plan Π π"
and ?𝒜⇩O = "valuation_for_operator_variables Π π ?τ"
and ?Op = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t} ∧ op ∈ set ?ops }"
and ?Op' = "{ Operator k (index ?ops op) | k op. k ∈ {0..<length ?τ - 1} ∧ op ∈ set ?ops }"
and ?V = "{ State k (index ?vs v) | k v. k ∈ {0..<?t + 1} ∧ v ∈ set ?vs }"
and ?v = "Operator l (index ?ops op)"
show ?thesis
proof (cases "op ∈ set ((Π)⇩𝒪)")
case True
{
{
have "?v ∈ ?Op"
using assms(3) True
by auto
hence "?𝒜⇩π ?v = ?𝒜⇩O ?v"
unfolding valuation_for_plan_def override_on_def Let_def
by simp
}
moreover {
have "l ∉ {0..<length ?τ - 1}"
using assms(2)
by simp
then have "?v ∉ ?Op'"
by blast
hence "?𝒜⇩O ?v = 𝒜⇩0 ?v"
unfolding valuation_for_operator_variables_def override_on_def
by meson
}
ultimately have "¬?𝒜⇩π ?v"
unfolding empty_valuation_def
by blast
}
then show ?thesis
by blast
next
case False
{
{
have "?Op = (λ(k, op). Operator k (index ?ops op)) ` ({0..<?t} × set ?ops)"
by fast
moreover have "¬index ?ops op < length ?ops"
using False
by simp
ultimately have "?v ∉ ?Op"
by fastforce
}
moreover have "?v ∉ ?V"
by force
ultimately have "?𝒜⇩π ?v = 𝒜⇩0 ?v"
unfolding valuation_for_plan_def override_on_def
by metis
hence "¬?𝒜⇩π ?v"
unfolding empty_valuation_def
by blast
}
thus ?thesis
by blast
qed
qed
corollary encode_problem_parallel_complete_vi_d:
fixes Π :: "'variable strips_problem"
assumes "is_parallel_solution_for_problem Π π"
and "k < length π"
and "op ∉ set (π ! k)"
shows "¬valuation_for_plan Π π (Operator k (index (strips_problem.operators_of Π) op))"
using encode_problem_parallel_complete_vi_a[OF assms(1)] assms(3)
encode_problem_parallel_complete_vi_b[OF assms(1) _ assms(2)] assms(3)
by (cases "k < length (trace_parallel_plan_strips ((Π)⇩I) π) - 1"; fastforce)
lemma list_product_is_nil_iff: "List.product xs ys = [] ⟷ xs = [] ∨ ys = []"
proof (rule iffI)
assume product_xs_ys_is_Nil: "List.product xs ys = []"
show "xs = [] ∨ ys = []"
proof (rule ccontr)
assume "¬(xs = [] ∨ ys = [])"
then have "xs ≠ []" and "ys ≠ []"
by simp+
then obtain x xs' y ys' where "xs = x # xs'" and "ys = y # ys'"
using list.exhaust
by metis
then have "List.product xs ys = (x, y) # map (Pair x) ys' @ List.product xs' (y # ys')"
by simp
thus False
using product_xs_ys_is_Nil
by simp
qed
next
assume "xs = [] ∨ ys = []"
thus "List.product xs ys = []"
proof (rule disjE)
assume ys_is_Nil: "ys = []"
show "List.product xs ys = []"
proof (induction xs)
case (Cons x xs)
have "List.product (x # xs) ys = map (Pair x) ys @ List.product xs ys"
by simp
also have "… = [] @ List.product xs ys"
using Nil_is_map_conv ys_is_Nil
by blast
finally show ?case
using Cons.IH
by force
qed auto
qed simp
qed
lemma valuation_for_state_variables_is:
assumes "k ∈ set ks"
and "v ∈ set vs"
shows "foldr (λ(k, v) 𝒜. valuation_for_state vs (s k) k v 𝒜) (List.product ks vs) 𝒜⇩0
(State k (index vs v))
⟷ (s k) v = Some True"
proof -
let ?v = "State k (index vs v)"
and ?ps = "List.product ks vs"
let ?𝒜 = "foldr (λ(k, v) 𝒜. valuation_for_state vs (s k) k v 𝒜) ?ps 𝒜⇩0"
and ?f = "λx. State (fst x) (index vs (snd x))"
and ?g = "λx. (s (fst x)) (snd x) = Some True"
have nb⇩1: "(k, v) ∈ set ?ps"
using assms(1, 2) set_product
by simp
moreover {
{
fix x y
assume x_in_ps: "x ∈ set ?ps" and y_in_ps: "y ∈ set ?ps"
and "¬(?f x = ?f y ⟶ x = y)"
then have f_x_is_f_y: "?f x = ?f y" and x_is_not_y: "x ≠ y"
by blast+
then obtain k' k'' v' v''
where x_is: "x = (k', v')"
and y_is: "y = (k'', v'')"
by fastforce
then consider (A) "k' ≠ k''"
| (B) "v' ≠ v''"
using x_is_not_y
by blast
hence False
proof (cases)
case A
then have "?f x ≠ ?f y"
using x_is y_is
by simp
thus ?thesis
using f_x_is_f_y
by argo
next
case B
have "v' ∈ set vs" and "v'' ∈ set vs"
using x_in_ps x_is y_in_ps y_is set_product
by blast+
then have "index vs v' ≠ index vs v''"
using B
by force
then have "?f x ≠ ?f y"
using x_is y_is
by simp
thus False
using f_x_is_f_y
by blast
qed
}
hence "inj_on ?f (set ?ps)"
using inj_on_def
by blast
} note nb⇩2 = this
{
have "foldr (λx. valuation_for_state vs (s (fst x)) (fst x) (snd x))
(List.product ks vs) 𝒜⇩0 (State (fst (k, v)) (index vs (snd (k, v)))) =
(s (fst (k, v)) (snd (k, v)) = Some True)"
using foldr_fun_upd[OF nb⇩2 nb⇩1, of ?g 𝒜⇩0]
by blast
moreover have "(λx. valuation_for_state vs (s (fst x)) (fst x) (snd x))
= (λ(k, v). valuation_for_state vs (s k) k v)"
by fastforce
ultimately have "?𝒜 (?f (k, v)) = ?g (k, v)"
by simp
}
thus ?thesis
by simp
qed
lemma encode_problem_parallel_complete_vi_c:
fixes Π :: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "k < length (trace_parallel_plan_strips ((Π)⇩I) π)"
shows "valuation_for_plan Π π (State k (index (strips_problem.variables_of Π) v))
⟷ (trace_parallel_plan_strips ((Π)⇩I) π ! k) v = Some True"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?t = "length π"
and ?t' = "length ?τ"
let ?𝒜⇩π = "valuation_for_plan Π π"
and ?𝒜⇩V = "valuation_for_state_variables Π π ?τ"
and ?𝒜⇩O = "valuation_for_state_variables Π π ?τ"
and ?𝒜⇩1 = "foldr
(λ(k, v) 𝒜. valuation_for_state ?vs (?τ ! k) k v 𝒜)
(List.product [0..<?t'] ?vs) 𝒜⇩0"
and ?Op = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t} ∧ op ∈ set ((Π)⇩𝒪) }"
and ?Op' = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t' - 1} ∧ op ∈ set ((Π)⇩𝒪) }"
and ?V = "{ State k (index ?vs v) | k v. k ∈ {0..<?t + 1} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?V⇩1 = "{ State k (index ?vs v) | k v. k ∈ {0..<?t'} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?V⇩2 = "{ State k (index ?vs v) | k v. k ∈ {?t'..(?t + 1)} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?v = "State k (index ?vs v)"
have v_notin_Op: "?v ∉ ?Op"
by blast
have k_lte_length_π_plus_one: "k < length π + 1"
using less_le_trans length_trace_parallel_plan_strips_lte_length_plan_plus_one assms(3)
by blast
show ?thesis
proof (cases "v ∈ set ((Π)⇩𝒱)")
case True
{
{
have "?v ∈ ?V" "?v ∉ ?Op"
using k_lte_length_π_plus_one True
by force+
hence "?𝒜⇩π ?v = ?𝒜⇩V ?v"
unfolding valuation_for_plan_def override_on_def Let_def
by simp
}
moreover {
have "?v ∈ ?V⇩1" "?v ∉ ?V⇩2"
using assms(3) True
by fastforce+
hence "?𝒜⇩V ?v = ?𝒜⇩1 ?v"
unfolding valuation_for_state_variables_def override_on_def Let_def
by force
}
ultimately have "?𝒜⇩π ?v = ?𝒜⇩1 ?v"
by blast
}
moreover have "k ∈ set [0..<?t']"
using assms(3)
by simp
moreover have "v ∈ set (strips_problem.variables_of Π)"
using True
by simp
ultimately show ?thesis
using valuation_for_state_variables_is[of k "[0..<?t']"]
by fastforce
next
case False
{
{
have "¬ index ?vs v < length ?vs"
using False index_less_size_conv
by simp
hence "?v ∉ ?V"
by fastforce
}
then have "¬?𝒜⇩π ?v"
using v_notin_Op
unfolding valuation_for_plan_def override_on_def empty_valuation_def Let_def
variables_of_def operators_of_def
by presburger
}
moreover have "¬(?τ ! k) v = Some True"
using trace_parallel_plan_strips_none_if[of Π π k v] assms(1, 2, 3) False
unfolding initial_of_def
by force
ultimately show ?thesis
by blast
qed
qed
lemma encode_problem_parallel_complete_vi_f:
fixes Π :: "'a strips_problem"
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "l ≥ length (trace_parallel_plan_strips ((Π)⇩I) π)"
and "l < length π + 1"
shows "valuation_for_plan Π π (State l (index (strips_problem.variables_of Π) v))
= valuation_for_plan Π π
(State (length (trace_parallel_plan_strips ((Π)⇩I) π) - 1)
(index (strips_problem.variables_of Π) v))"
proof -
let ?vs = "strips_problem.variables_of Π"
and ?ops = "strips_problem.operators_of Π"
and ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?t = "length π"
and ?t' = "length ?τ"
let ?τ⇩Ω = "?τ ! (?t' - 1)"
and ?𝒜⇩π = "valuation_for_plan Π π"
and ?𝒜⇩V = "valuation_for_state_variables Π π ?τ"
and ?𝒜⇩O = "valuation_for_state_variables Π π ?τ"
let ?𝒜⇩2 = "foldr
(λ(k, v) 𝒜. valuation_for_state (strips_problem.variables_of Π) ?τ⇩Ω k v 𝒜)
(List.product [?t'..<length π + 2] ?vs)
𝒜⇩0"
and ?Op = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t} ∧ op ∈ set ((Π)⇩𝒪) }"
and ?Op' = "{ Operator k (index ?ops op) | k op. k ∈ {0..<?t' - 1} ∧ op ∈ set ((Π)⇩𝒪) }"
and ?V = "{ State k (index ?vs v) | k v. k ∈ {0..<?t + 1} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?V⇩1 = "{ State k (index ?vs v) | k v. k ∈ {0..<?t'} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?V⇩2 = "{ State k (index ?vs v) | k v. k ∈ {?t'..(?t + 1)} ∧ v ∈ set ((Π)⇩𝒱) }"
and ?v = "State l (index ?vs v)"
have v_notin_Op: "?v ∉ ?Op"
by blast
show ?thesis
proof (cases "v ∈ set ((Π)⇩𝒱)")
case True
{
{
have "?v ∈ ?V" "?v ∉ ?Op"
using assms(4) True
by force+
hence "?𝒜⇩π ?v = ?𝒜⇩V ?v"
unfolding valuation_for_plan_def override_on_def Let_def
by simp
}
moreover {
have "?v ∉ ?V⇩1" "?v ∈ ?V⇩2"
using assms(3, 4) True
by force+
hence "?𝒜⇩V ?v = ?𝒜⇩2 ?v"
unfolding valuation_for_state_variables_def override_on_def Let_def
by auto
}
ultimately have "?𝒜⇩π ?v = ?𝒜⇩2 ?v"
by blast
} note nb = this
moreover
{
have "l ∈ set [?t'..<?t + 2]"
using assms(3, 4)
by auto
hence "?𝒜⇩2 ?v ⟷ ?τ⇩Ω v = Some True"
using valuation_for_state_variables_is[of l "[?t'..<?t + 2]"] True nb
by fastforce
}
ultimately have "?𝒜⇩π ?v ⟷ ?τ⇩Ω v = Some True"
by fast
moreover {
have "0 < ?t'"
using trace_parallel_plan_strips_not_nil
by blast
then have "?t' - 1 < ?t'"
using diff_less
by presburger
}
ultimately show ?thesis
using encode_problem_parallel_complete_vi_c[of _ _ "?t' - 1", OF assms(1, 2)]
by blast
next
case False
{
{
have "¬ index ?vs v < length ?vs"
using False index_less_size_conv
by auto
hence "?v ∉ ?V"
by fastforce
}
then have "¬?𝒜⇩π ?v"
using v_notin_Op
unfolding valuation_for_plan_def override_on_def empty_valuation_def Let_def
variables_of_def operators_of_def
by presburger
}
moreover {
have "0 < ?t'"
using trace_parallel_plan_strips_not_nil
by blast
then have "?t' - 1 < ?t'"
by simp
}
moreover have "¬((?τ ! (?t' - 1)) v = Some True)"
using trace_parallel_plan_strips_none_if[of _ _ "?t' - 1" v, OF _ assms(2) calculation(2)]
assms(1) False
by simp
ultimately show ?thesis
using encode_problem_parallel_complete_vi_c[of _ _ "?t' - 1", OF assms(1, 2)]
by blast
qed
qed
text ‹ Let now \<^term>‹τ ≡ trace_parallel_plan_strips I π› be the trace of the plan \<^term>‹π›, \<^term>‹t ≡ length π›, and
\<^term>‹t' ≡ length τ›.
Any model of the SATPlan encoding \<^term>‹𝒜› must satisfy the following properties:
\footnote{Cf. \cite[Theorem 3.1, p. 1044]{DBLP:journals/ai/RintanenHN06} for the construction
of \<^term>‹𝒜›.}
\begin{enumerate}
\item for all \<^term>‹k› and for all \<^term>‹op› with \<^term>‹k < t' - 1›
@{text[display, indent=4] "𝒜 (Operator k (index (operators_of Π) op)) = op ∈ set (π ! k)"}
\item for all \<^term>‹l› and for all \<^term>‹op› with \<^term>‹l ≥ t' - 1› and
\<^term>‹l < length π› we require
@{text[display, indent=4] "𝒜 (Operator l (index (operators_of Π) op))"}
\item for all \<^term>‹v› and for all \<^term>‹k› with \<^term>‹k < t'› we require
@{text[display, indent=4] "𝒜 (State k (index (variables_of Π) v)) ⟶ ((τ ! k) v = Some True)"}
\item and finally for all \<^term>‹v› and for all \<^term>‹l› with \<^term>‹l ≥ t'› and \<^term>‹l < t + 1› we require
@{text[display, indent=4] "𝒜 (State l (index (variables_of Π) v))
= 𝒜 (State (t' - 1) (index (variables_of Π) v))"}
\end{enumerate}
Condition ``1.'' states that the model must reflect operator activation for all operators in the
parallel operator lists \<^term>‹π ! k› of the plan \<^term>‹π› for each time step \<^term>‹k < t' - 1› s.t. there is a
successor state in the trace. Moreover ``3.''
requires that the model is consistent with the states reached during plan execution (i.e. the
elements \<^term>‹τ ! k› for \<^term>‹k < t'› of the trace \<^term>‹τ›). Meaning that
\<^term>‹𝒜 (State k (index (strips_problem.variables_of Π) v))› for the SAT plan variable of
every state variable \<^term>‹v› at time point \<^term>‹k› if and only if \<^term>‹(τ ! k) v = Some True›
for the corresponding state \<^term>‹τ ! k› at time \<^term>‹k› (and
\<^term>‹¬𝒜 (State k (index (strips_problem.variables_of Π) v))› otherwise).
The second respectively fourth condition cover early plan termination by negating operator
activation and propagating the last reached state. Note that in the state propagation constraint,
the index is incremented by one compared to the similar constraint for operators, since operator
activations are always followed by at least one successor state.
Hence the last state in the trace has index
\<^term>‹length (trace_parallel_plan_strips ((Π::'variable strips_problem)⇩I) π) - 1› and the remaining states
take up the indexes to \<^term>‹length π + 1›.
% TODO Comments on how the partial encoding modeling follows from the construction (lemmas ...). ›
value "stop"
theorem
encode_problem_parallel_complete:
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
shows "valuation_for_plan Π π ⊨ Φ Π (length π)"
proof -
let ?t = "length π"
and ?I = "(Π)⇩I"
and ?G = "(Π)⇩G"
and ?𝒜 = "valuation_for_plan Π π"
have nb: "?G ⊆⇩m execute_parallel_plan ?I π"
using assms(2)
unfolding is_parallel_solution_for_problem_def
by force
have "?𝒜 ⊨ Φ⇩I Π"
using encode_problem_parallel_complete_i[OF assms(1) nb]
encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
by presburger
moreover have "?𝒜 ⊨ (Φ⇩G Π) ?t"
using encode_problem_parallel_complete_ii[OF assms(1) nb]
encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
encode_problem_parallel_complete_vi_f[OF assms(1, 2)]
by presburger
moreover have "?𝒜 ⊨ encode_operators Π ?t"
using encode_problem_parallel_complete_iii[OF assms(1) nb]
encode_problem_parallel_complete_vi_a[OF assms(2)]
encode_problem_parallel_complete_vi_b[OF assms(2)]
encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
by presburger
moreover have "?𝒜 ⊨ encode_all_frame_axioms Π ?t"
using encode_problem_parallel_complete_iv[OF assms(1, 2)]
encode_problem_parallel_complete_vi_a[OF assms(2)]
encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
encode_problem_parallel_complete_vi_f[OF assms(1, 2)]
by presburger
ultimately show ?thesis
unfolding encode_problem_def SAT_Plan_Base.encode_problem_def
encode_initial_state_def encode_goal_state_def
by auto
qed
end
Theory SAT_Plan_Extensions
theory SAT_Plan_Extensions
imports SAT_Plan_Base
begin
section "Serializable SATPlan Encodings"
text ‹ A SATPlan encoding with exclusion of operator interference (see definition
\ref{def:sat-plan-encoding-with-interference-exclusion}) can be defined by extending the basic
SATPlan encoding with clauses
@{text[display, indent=4] "
❙¬(Atom (Operator k (index ops op⇩1))
❙∨ ❙¬(Atom (Operator k (index ops op⇩2))"}
for all pairs of distinct interfering operators \<^term>‹op⇩1›, \<^term>‹op⇩2› for all time points
\<^term>‹k < t› for a given estimated plan length \<^term>‹t›. Definitions
\ref{isadef:interfering-operator-pair-exclusion-encoding} and
\ref{isadef:interfering-operator-exclusion-encoding} implement the encoding for operator pairs
resp. for all interfering operator pairs and all time points. ›
definition encode_interfering_operator_pair_exclusion
:: "'variable strips_problem
⇒ nat
⇒ 'variable strips_operator
⇒ 'variable strips_operator
⇒ sat_plan_variable formula"
where "encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2
≡ let ops = operators_of Π in
❙¬(Atom (Operator k (index ops op⇩1)))
❙∨ ❙¬(Atom (Operator k (index ops op⇩2)))"
definition encode_interfering_operator_exclusion
:: "'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula"
where "encode_interfering_operator_exclusion Π t ≡ let
ops = operators_of Π
; interfering = filter (λ(op⇩1, op⇩2). index ops op⇩1 ≠ index ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2) (List.product ops ops)
in foldr (❙∧) [encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← interfering, k ← [0..<t]] (❙¬⊥)"
text ‹ A SATPlan encoding with interfering operator pair exclusion can now be defined by
simplying adding the conjunct \<^term>‹encode_interfering_operator_exclusion Π t› to the basic
SATPlan encoding. ›
definition encode_problem_with_operator_interference_exclusion
:: "'variable strips_problem ⇒ nat ⇒ sat_plan_variable formula"
("Φ⇩∀ _ _" 52)
where "encode_problem_with_operator_interference_exclusion Π t
≡ encode_initial_state Π
❙∧ (encode_operators Π t
❙∧ (encode_all_frame_axioms Π t
❙∧ (encode_interfering_operator_exclusion Π t
❙∧ (encode_goal_state Π t))))"
lemma cnf_of_encode_interfering_operator_pair_exclusion_is_i[simp]:
"cnf (encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) = {{
(Operator k (index (strips_problem.operators_of Π) op⇩1))¯
, (Operator k (index (strips_problem.operators_of Π) op⇩2))¯ }}"
proof -
let ?ops = "strips_problem.operators_of Π"
have "cnf (encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2)
= cnf (❙¬(Atom (Operator k (index ?ops op⇩1))) ❙∨ ❙¬(Atom (Operator k (index ?ops op⇩2))))"
unfolding encode_interfering_operator_pair_exclusion_def
by metis
also have "… = { C ∪ D | C D.
C ∈ cnf (❙¬(Atom (Operator k (index ?ops op⇩1))))
∧ D ∈ cnf (❙¬(Atom (Operator k (index ?ops op⇩2)))) }"
by simp
finally show ?thesis
by auto
qed
lemma cnf_of_encode_interfering_operator_exclusion_is_ii[simp]:
"set [encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← filter (λ(op⇩1, op⇩2).
index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2
∧ are_operators_interfering op⇩1 op⇩2)
(List.product (strips_problem.operators_of Π) (strips_problem.operators_of Π))
, k ← [0..<t]]
= (⋃(op⇩1, op⇩2)
∈ { (op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π).
index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
(λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t})"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?interfering = "filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2) (List.product ?ops ?ops)"
let ?fs = "[encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← ?interfering, k ← [0..<t]]"
have "set ?fs = ⋃(set
` (λ(op⇩1, op⇩2). map (λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) [0..<t])
` (set (filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2 ∧ are_operators_interfering op⇩1 op⇩2)
(List.product ?ops ?ops))))"
unfolding set_concat set_map
by blast
also have "… = ⋃((λ(op⇩1, op⇩2).
set (map (λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) [0..<t]))
` (set (filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2 ∧ are_operators_interfering op⇩1 op⇩2)
(List.product ?ops ?ops))))"
unfolding image_comp[of
set "λ(op⇩1, op⇩2). map (λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) [0..<t]"]
comp_apply
by fast
also have "… = ⋃((λ(op⇩1, op⇩2).
(λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t})
` (set (filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2 ∧ are_operators_interfering op⇩1 op⇩2)
(List.product ?ops ?ops))))"
unfolding set_map[of _ "[0..<t]"] atLeastLessThan_upt[of 0 t]
by blast
also have "… = ⋃((λ(op⇩1, op⇩2).
(λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t})
` (Set.filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2 ∧ are_operators_interfering op⇩1 op⇩2)
(set (List.product ?ops ?ops))))"
unfolding set_filter[of "λ(op⇩1, op⇩2). are_operators_interfering op⇩1 op⇩2" "List.product ?ops ?ops"]
by force
finally show ?thesis
unfolding operators_of_def set_product[of ?ops ?ops]
by fastforce
qed
lemma cnf_of_encode_interfering_operator_exclusion_is_iii[simp]:
fixes Π :: "'variable strips_problem"
shows "cnf ` set [encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← filter (λ(op⇩1, op⇩2).
index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2
∧ are_operators_interfering op⇩1 op⇩2)
(List.product (strips_problem.operators_of Π) (strips_problem.operators_of Π))
, k ← [0..<t]]
= (⋃(op⇩1, op⇩2)
∈ { (op⇩1, op⇩2) ∈ set (strips_problem.operators_of Π) × set (strips_problem.operators_of Π).
index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
{{{ (Operator k (index (strips_problem.operators_of Π) op⇩1))¯
, (Operator k (index (strips_problem.operators_of Π) op⇩2))¯ }} | k. k ∈ {0..<t}})"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?interfering = "filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2) (List.product ?ops ?ops)"
let ?fs = "[encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← ?interfering, k ← [0..<t]]"
have "cnf ` set ?fs = cnf ` (⋃(op⇩1, op⇩2) ∈ { (op⇩1, op⇩2).
(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π) ∧ index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
(λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t})"
unfolding cnf_of_encode_interfering_operator_exclusion_is_ii
by blast
also have "… = (⋃(op⇩1, op⇩2) ∈ { (op⇩1, op⇩2).
(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π) ∧ index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
(λk. cnf (encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2)) ` {0..<t})"
unfolding image_Un image_comp comp_apply
by blast
also have "… = (⋃(op⇩1, op⇩2) ∈ { (op⇩1, op⇩2).
(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π) ∧ index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
(λk. {{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }}) ` {0..<t})"
by simp
also have "… = (⋃(op⇩1, op⇩2) ∈ { (op⇩1, op⇩2).
(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π) ∧ index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
(λk. {{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }})
` { k | k. k ∈ {0..<t}})"
by blast
finally show ?thesis
unfolding operators_of_def setcompr_eq_image[of _ "λk. k ∈ {0..<t}"]
by force
qed
lemma cnf_of_encode_interfering_operator_exclusion_is:
"cnf (encode_interfering_operator_exclusion Π t) = ⋃(⋃(op⇩1, op⇩2)
∈ { (op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π).
index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }.
{{{ (Operator k (index (strips_problem.operators_of Π) op⇩1))¯
, (Operator k (index (strips_problem.operators_of Π) op⇩2))¯ }} | k. k ∈ {0..<t}})"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?interfering = "filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2) (List.product ?ops ?ops)"
let ?fs = "[encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← ?interfering, k ← [0..<t]]"
have "cnf (encode_interfering_operator_exclusion Π t) = cnf (foldr (❙∧) ?fs (❙¬⊥))"
unfolding encode_interfering_operator_exclusion_def
by metis
also have "… = ⋃(cnf ` set ?fs)"
unfolding cnf_foldr_and[of ?fs]..
finally show ?thesis
unfolding cnf_of_encode_interfering_operator_exclusion_is_iii[of Π t]
by blast
qed
lemma cnf_of_encode_interfering_operator_exclusion_contains_clause_if:
fixes Π :: "'variable strips_problem"
assumes "k < t"
and "op⇩1 ∈ set (strips_problem.operators_of Π)" and "op⇩2 ∈ set (strips_problem.operators_of Π)"
and "index (strips_problem.operators_of Π) op⇩1 ≠ index (strips_problem.operators_of Π) op⇩2"
and "are_operators_interfering op⇩1 op⇩2"
shows "{ (Operator k (index (strips_problem.operators_of Π) op⇩1))¯
, (Operator k (index (strips_problem.operators_of Π) op⇩2))¯}
∈ cnf (encode_interfering_operator_exclusion Π t)"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?Φ⇩X = "encode_interfering_operator_exclusion Π t"
let ?Ops = "{ (op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π).
index ?ops op⇩1 ≠ index ?ops op⇩2 ∧ are_operators_interfering op⇩1 op⇩2 }"
and ?f = "λ(op⇩1, op⇩2). {{{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }}
| k. k ∈ {0..<t}}"
let ?A = "(⋃(op⇩1, op⇩2) ∈ ?Ops. ?f (op⇩1, op⇩2))"
let ?B = "⋃?A"
and ?C = "{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }"
{
have "(op⇩1, op⇩2) ∈ ?Ops"
using assms(2, 3, 4, 5)
unfolding operators_of_def
by force
moreover have "{ ?C } ∈ ?f (op⇩1, op⇩2)"
using assms(1)
by auto
moreover have "{ ?C } ∈ ?A"
using UN_iff[of ?C _ ?Ops] calculation(1, 2)
by blast
ultimately have "∃X ∈ ?A. ?C ∈ X"
by auto
}
thus ?thesis
unfolding cnf_of_encode_interfering_operator_exclusion_is
using Union_iff[of ?C ?A]
by auto
qed
lemma is_cnf_encode_interfering_operator_exclusion:
fixes Π :: "'variable strips_problem"
shows "is_cnf (encode_interfering_operator_exclusion Π t)"
proof -
let ?ops = "strips_problem.operators_of Π"
let ?interfering = "filter (λ(op⇩1, op⇩2). index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2) (List.product ?ops ?ops)"
let ?fs = "[encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2.
(op⇩1, op⇩2) ← ?interfering, k ← [0..<t]]"
let ?Fs = "(⋃(op⇩1, op⇩2)
∈ { (op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π). are_operators_interfering op⇩1 op⇩2 }.
(λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t})"
{
fix f
assume "f ∈ set ?fs"
then have "f ∈ ?Fs"
unfolding cnf_of_encode_interfering_operator_exclusion_is_ii
by blast
then obtain op⇩1 op⇩2
where "(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π)"
and "are_operators_interfering op⇩1 op⇩2"
and "f ∈ (λk. encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2) ` {0..<t}"
by fast
then obtain k where "f = encode_interfering_operator_pair_exclusion Π k op⇩1 op⇩2"
by blast
then have "f = ❙¬(Atom (Operator k (index ?ops op⇩1))) ❙∨ ❙¬(Atom (Operator k (index ?ops op⇩2)))"
unfolding encode_interfering_operator_pair_exclusion_def
by metis
hence "is_cnf f"
by force
}
thus ?thesis
unfolding encode_interfering_operator_exclusion_def
using is_cnf_foldr_and_if[of ?fs]
by meson
qed
lemma is_cnf_encode_problem_with_operator_interference_exclusion:
assumes "is_valid_problem_strips Π"
shows "is_cnf (Φ⇩∀ Π t)"
using is_cnf_encode_problem is_cnf_encode_interfering_operator_exclusion assms
unfolding encode_problem_with_operator_interference_exclusion_def SAT_Plan_Base.encode_problem_def
is_cnf.simps(1)
by blast
lemma cnf_of_encode_problem_with_operator_interference_exclusion_structure:
shows "cnf (Φ⇩I Π) ⊆ cnf (Φ⇩∀ Π t)"
and "cnf ((Φ⇩G Π) t) ⊆ cnf (Φ⇩∀ Π t)"
and "cnf (encode_operators Π t) ⊆ cnf (Φ⇩∀ Π t)"
and "cnf (encode_all_frame_axioms Π t) ⊆ cnf (Φ⇩∀ Π t)"
and "cnf (encode_interfering_operator_exclusion Π t) ⊆ cnf (Φ⇩∀ Π t)"
unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def SAT_Plan_Base.encode_problem_def
encode_initial_state_def
encode_goal_state_def
by auto+
lemma encode_problem_with_operator_interference_exclusion_has_model_then_also_partial_encodings:
assumes "𝒜 ⊨ Φ⇩∀ Π t"
shows "𝒜 ⊨ SAT_Plan_Base.encode_initial_state Π"
and "𝒜 ⊨ SAT_Plan_Base.encode_operators Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_all_frame_axioms Π t"
and "𝒜 ⊨ encode_interfering_operator_exclusion Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_goal_state Π t"
using assms
unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def SAT_Plan_Base.encode_problem_def
by simp+
text ‹ Just as for the basic SATPlan encoding we defined local context for the SATPlan encoding
with interfering operator exclusion. We omit this here since it is basically identical to the one
shown in the basic SATPlan theory replacing only the definitions of \isaname{encode_transitions}
and \isaname{encode_problem}. The sublocale proof is shown below. It confirms that the new
encoding again a CNF as required by locale \isaname{sat_encode_strips}. ›
subsection "Soundness"
text ‹ The Proof of soundness for the SATPlan encoding with interfering operator exclusion follows
directly from the proof of soundness of the basic SATPlan encoding. By looking at the structure of
the new encoding which simply extends the basic SATPlan encoding with a conjunct, any model for
encoding with exclusion of operator interference also models the basic SATPlan encoding and the
soundness of the new encoding therefore follows from theorem
\ref{isathm:soundness-satplan-encoding}.
Moreover, since we additionally added interfering operator exclusion clauses at every timestep, the
decoded parallel plan cannot contain any interfering operators in any parallel operator (making it
serializable). ›
lemma encode_problem_serializable_sound_i:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ⇩∀ Π t"
and "k < t"
and "ops ∈ set (subseqs ((Φ¯ Π 𝒜 t) ! k))"
shows "are_all_operators_non_interfering ops"
proof -
let ?ops = "strips_problem.operators_of Π"
and ?π = "Φ¯ Π 𝒜 t"
and ?Φ⇩X = "encode_interfering_operator_exclusion Π t"
let ?π⇩k = "(Φ¯ Π 𝒜 t) ! k"
{
fix C
assume C_in: "C ∈ cnf ?Φ⇩X"
have "cnf_semantics 𝒜 (cnf ?Φ⇩X)"
using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(2)
is_cnf_encode_problem_with_operator_interference_exclusion[OF assms(1)]
cnf_of_encode_problem_with_operator_interference_exclusion_structure(5)].
hence "clause_semantics 𝒜 C"
unfolding cnf_semantics_def
using C_in
by fast
} note nb⇩1 = this
{
fix op⇩1 op⇩2
assume "op⇩1 ∈ set ?π⇩k" and "op⇩2 ∈ set ?π⇩k"
and index_op⇩1_is_not_index_op⇩2: "index ?ops op⇩1 ≠ index ?ops op⇩2"
moreover have op⇩1_in: "op⇩1 ∈ set ?ops" and 𝒜_models_op⇩1:"𝒜 (Operator k (index ?ops op⇩1))"
and op⇩2_in: "op⇩2 ∈ set ?ops" and 𝒜_models_op⇩2: "𝒜 (Operator k (index ?ops op⇩2))"
using decode_plan_step_element_then[OF assms(3)] calculation
unfolding decode_plan_def
by blast+
moreover {
let ?C = "{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }"
assume "are_operators_interfering op⇩1 op⇩2"
moreover have "?C ∈ cnf ?Φ⇩X"
using cnf_of_encode_interfering_operator_exclusion_contains_clause_if[OF
assms(3) op⇩1_in op⇩2_in index_op⇩1_is_not_index_op⇩2] calculation
by blast
moreover have "¬clause_semantics 𝒜 ?C"
using 𝒜_models_op⇩1 𝒜_models_op⇩2
unfolding clause_semantics_def
by auto
ultimately have False
using nb⇩1
by blast
}
ultimately have "¬are_operators_interfering op⇩1 op⇩2"
by blast
} note nb⇩3 = this
show ?thesis
using assms
proof (induction ops)
case (Cons op⇩1 ops)
have "are_all_operators_non_interfering ops"
using Cons.IH[OF Cons.prems(1, 2, 3) Cons_in_subseqsD[OF Cons.prems(4)]]
by blast
moreover {
fix op⇩2
assume op⇩2_in_ops: "op⇩2 ∈ set ops"
moreover have op⇩1_in_π⇩k: "op⇩1 ∈ set ?π⇩k" and op⇩2_in_π⇩k: "op⇩2 ∈ set ?π⇩k"
using element_of_subseqs_then_subset[OF Cons.prems(4)] calculation(1)
by auto+
moreover
{
have "distinct (op⇩1 # ops)"
using subseqs_distinctD[OF Cons.prems(4)]
decode_plan_step_distinct[OF Cons.prems(3)]
unfolding decode_plan_def
by blast
moreover have "op⇩1 ∈ set ?ops" and "op⇩2 ∈ set ?ops"
using decode_plan_step_element_then(1)[OF Cons.prems(3)] op⇩1_in_π⇩k op⇩2_in_π⇩k
unfolding decode_plan_def
by force+
moreover have "op⇩1 ≠ op⇩2"
using op⇩2_in_ops calculation(1)
by fastforce
ultimately have "index ?ops op⇩1 ≠ index ?ops op⇩2"
using index_eq_index_conv
by auto
}
ultimately have "¬are_operators_interfering op⇩1 op⇩2"
using nb⇩3
by blast
}
ultimately show ?case
using list_all_iff
by auto
qed simp
qed
theorem encode_problem_serializable_sound:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ⇩∀ Π t"
shows "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
and "∀k < length (Φ¯ Π 𝒜 t). are_all_operators_non_interfering ((Φ¯ Π 𝒜 t) ! k)"
proof -
{
have "𝒜 ⊨ SAT_Plan_Base.encode_initial_state Π"
and "𝒜 ⊨ SAT_Plan_Base.encode_operators Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_all_frame_axioms Π t"
and "𝒜 ⊨ SAT_Plan_Base.encode_goal_state Π t"
using assms(2)
unfolding encode_problem_with_operator_interference_exclusion_def
by simp+
then have "𝒜 ⊨ SAT_Plan_Base.encode_problem Π t"
unfolding SAT_Plan_Base.encode_problem_def
by simp
}
thus "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
using encode_problem_parallel_sound assms(1, 2)
unfolding decode_plan_def
by blast
next
let ?π = "Φ¯ Π 𝒜 t"
{
fix k
assume "k < t"
moreover have "?π ! k ∈ set (subseqs (?π ! k))"
using subseqs_refl
by blast
ultimately have "are_all_operators_non_interfering (?π ! k)"
using encode_problem_serializable_sound_i[OF assms]
unfolding SAT_Plan_Base.decode_plan_def decode_plan_def
by blast
}
moreover have "length ?π = t"
unfolding SAT_Plan_Base.decode_plan_def decode_plan_def
by simp
ultimately show "∀k < length ?π. are_all_operators_non_interfering (?π ! k)"
by simp
qed
subsection "Completeness"
lemma encode_problem_with_operator_interference_exclusion_complete_i:
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "∀k < length π. are_all_operators_non_interfering (π ! k)"
shows "valuation_for_plan Π π ⊨ encode_interfering_operator_exclusion Π (length π)"
proof -
let ?𝒜 = "valuation_for_plan Π π"
and ?Φ⇩X = "encode_interfering_operator_exclusion Π (length π)"
and ?ops = "strips_problem.operators_of Π"
and ?t = "length π"
let ?τ = "trace_parallel_plan_strips ((Π)⇩I) π"
let ?Ops = "{ (op⇩1, op⇩2). (op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π)
∧ index ?ops op⇩1 ≠ index ?ops op⇩2
∧ are_operators_interfering op⇩1 op⇩2 }"
and ?f = "λ(op⇩1, op⇩2). {{{ (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }}
| k. k ∈ {0..<length π} }"
let ?A = "⋃(?f ` ?Ops)"
let ?B = "⋃?A"
have nb⇩1: "∀ops ∈ set π. ∀op ∈ set ops. op ∈ set (operators_of Π)"
using is_parallel_solution_for_problem_operator_set[OF assms(2)]
unfolding operators_of_def
by blast
{
fix k op
assume "k < length π" and "op ∈ set (π ! k)"
hence "lit_semantics ?𝒜 ((Operator k (index ?ops op))⇧+) = (k < length ?τ - 1)"
using encode_problem_parallel_complete_vi_a[OF assms(2)]
encode_problem_parallel_complete_vi_b[OF assms(2)] initial_of_def
by(cases "k < length ?τ - 1"; simp)
} note nb⇩2 = this
{
fix k op⇩1 op⇩2
assume "k < length π"
and "op⇩1 ∈ set (π ! k)"
and "index ?ops op⇩1 ≠ index ?ops op⇩2"
and "are_operators_interfering op⇩1 op⇩2"
moreover have "are_all_operators_non_interfering (π ! k)"
using assms(3) calculation(1)
by blast
moreover have "op⇩1 ≠ op⇩2"
using calculation(3)
by blast
ultimately have "op⇩2 ∉ set (π ! k)"
using are_all_operators_non_interfering_set_contains_no_distinct_interfering_operator_pairs
assms(3)
by blast
} note nb⇩3 = this
{
fix C
assume "C ∈ cnf ?Φ⇩X"
then have "C ∈ ?B"
using cnf_of_encode_interfering_operator_exclusion_is[of Π "length π"]
by argo
then obtain C' where "C' ∈ ?A" and C_in: "C ∈ C'"
using Union_iff[of C ?A]
by meson
then obtain op⇩1 op⇩2 where "(op⇩1, op⇩2) ∈ set (operators_of Π) × set (operators_of Π)"
and index_op⇩1_is_not_index_op⇩2: "index ?ops op⇩1 ≠ index ?ops op⇩2"
and are_operators_interfering_op⇩1_op⇩2: "are_operators_interfering op⇩1 op⇩2"
and C'_in: "C' ∈ {{{(Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯}}
| k. k ∈ {0..<length π}}"
using UN_iff[of C' ?f ?Ops]
by blast
then obtain k where "k ∈ {0..<length π}"
and C_is: "C = { (Operator k (index ?ops op⇩1))¯, (Operator k (index ?ops op⇩2))¯ }"
using C_in C'_in
by blast
then have k_lt_length_π: "k < length π"
by simp
consider (A) "op⇩1 ∈ set (π ! k)"
| (B) "op⇩2 ∈ set (π ! k)"
| (C) "¬op⇩1 ∈ set (π ! k) ∨ ¬op⇩2 ∈ set (π ! k)"
by linarith
hence "clause_semantics ?𝒜 C"
proof (cases)
case A
moreover have "op⇩2 ∉ set (π ! k)"
using nb⇩3 k_lt_length_π calculation index_op⇩1_is_not_index_op⇩2 are_operators_interfering_op⇩1_op⇩2
by blast
moreover have "¬?𝒜 (Operator k (index ?ops op⇩2))"
using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
calculation(2)
by blast
ultimately show ?thesis
using C_is
unfolding clause_semantics_def
by force
next
case B
moreover have "op⇩1 ∉ set (π ! k)"
using nb⇩3 k_lt_length_π calculation index_op⇩1_is_not_index_op⇩2 are_operators_interfering_op⇩1_op⇩2
by blast
moreover have "¬?𝒜 (Operator k (index ?ops op⇩1))"
using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
calculation(2)
by blast
ultimately show ?thesis
using C_is
unfolding clause_semantics_def
by force
next
case C
then show ?thesis
proof (rule disjE)
assume "op⇩1 ∉ set (π ! k)"
then have "¬?𝒜 (Operator k (index ?ops op⇩1))"
using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
by blast
thus "clause_semantics (valuation_for_plan Π π) C"
using C_is
unfolding clause_semantics_def
by force
next
assume "op⇩2 ∉ set (π ! k)"
then have "¬?𝒜 (Operator k (index ?ops op⇩2))"
using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
by blast
thus "clause_semantics (valuation_for_plan Π π) C"
using C_is
unfolding clause_semantics_def
by force
qed
qed
}
then have "cnf_semantics ?𝒜 (cnf ?Φ⇩X)"
unfolding cnf_semantics_def..
thus ?thesis
using cnf_semantics[OF is_nnf_cnf[OF is_cnf_encode_interfering_operator_exclusion]]
by fast
qed
text ‹ Similar to the soundness proof, we may reuse the previously established
facts about the valuation for the completeness proof of the basic SATPlan encoding
(\ref{isathm:completeness-satplan-encoding}).
To make it clearer why this is true we have a look at the form of the clauses for interfering operator
pairs \<^term>‹op⇩1› and \<^term>‹op⇩2› at the same time index \<^term>‹k› which have the form shown below:
@{text[display, indent=4] "{ (Operator k (index ops op⇩1))¯, (Operator k (index ops op⇩2))¯ }"}
where \<^term>‹ops ≡ strips_problem.operators_of Π›.
Now, consider an operator \<^term>‹op⇩1› that is contained in the \<^term>‹k›-th plan step \<^term>‹π ! k›
(symmetrically for \<^term>‹op⇩2›). Since \<^term>‹π› is a serializable solution, there can be no
interference between \<^term>‹op⇩1› and \<^term>‹op⇩2› at time \<^term>‹k›. Hence \<^term>‹op⇩2› cannot be in \<^term>‹π ! k›
This entails that for \<^term>‹𝒜 ≡ valuation_for_plan Π π› it holds that
@{text[display, indent=4] "𝒜 ⊨ ❙¬ Atom (Operator k (index ops op⇩2))"}
and \<^term>‹𝒜› therefore models the clause.
Furthermore, if neither is present, than \<^term>‹𝒜› will evaluate both atoms to false and the clause
therefore evaluates to true as well.
It follows from this that each clause in the extension of the SATPlan encoding evaluates to true
for \<^term>‹𝒜›. The other parts of the encoding evaluate to true as per the completeness of the
basic SATPlan encoding (theorem \ref{isathm:completeness-satplan-encoding}).›
theorem encode_problem_serializable_complete:
assumes "is_valid_problem_strips Π"
and "is_parallel_solution_for_problem Π π"
and "∀k < length π. are_all_operators_non_interfering (π ! k)"
shows "valuation_for_plan Π π ⊨ Φ⇩∀ Π (length π)"
proof -
let ?𝒜 = "valuation_for_plan Π π"
and ?Φ⇩X = "encode_interfering_operator_exclusion Π (length π)"
have "?𝒜 ⊨ SAT_Plan_Base.encode_problem Π (length π)"
using assms(1, 2) encode_problem_parallel_complete
by auto
moreover have "?𝒜 ⊨ ?Φ⇩X"
using encode_problem_with_operator_interference_exclusion_complete_i[OF assms].
ultimately show ?thesis
unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def
SAT_Plan_Base.encode_problem_def
by force
qed
value "stop"
lemma encode_problem_forall_step_decoded_plan_is_serializable_i:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ⇩∀ Π t"
shows "(Π)⇩G ⊆⇩m execute_serial_plan ((Π)⇩I) (concat (Φ¯ Π 𝒜 t))"
proof -
let ?G = "(Π)⇩G"
and ?I = "(Π)⇩I"
and ?π = "Φ¯ Π 𝒜 t"
let ?π' = "concat (Φ¯ Π 𝒜 t)"
and ?τ = "trace_parallel_plan_strips ?I ?π"
and ?σ = "map (decode_state_at Π 𝒜) [0..<Suc (length ?π)]"
{
fix k
assume k_lt_length_π: "k < length ?π"
moreover have "𝒜 ⊨ SAT_Plan_Base.encode_problem Π t"
using assms(2)
unfolding encode_problem_with_operator_interference_exclusion_def
encode_problem_def SAT_Plan_Base.encode_problem_def
by simp
moreover have "length ?σ = length ?τ"
using encode_problem_parallel_correct_vii assms(1) calculation
unfolding decode_state_at_def decode_plan_def initial_of_def
by fast
ultimately have "k < length ?τ - 1" and "k < t"
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
by force+
} note nb = this
{
have "?G ⊆⇩m execute_parallel_plan ?I ?π"
using encode_problem_serializable_sound assms
unfolding is_parallel_solution_for_problem_def decode_plan_def
goal_of_def initial_of_def
by blast
hence "?G ⊆⇩m last (trace_parallel_plan_strips ?I ?π)"
using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace
by fast
}
moreover {
fix k
assume k_lt_length_π: "k < length ?π"
moreover have "k < length ?τ - 1" and "k < t"
using nb calculation
by blast+
moreover have "are_all_operators_applicable (?τ ! k) (?π ! k)"
and "are_all_operator_effects_consistent (?π ! k)"
using trace_parallel_plan_strips_operator_preconditions calculation(2)
by blast+
moreover have "are_all_operators_non_interfering (?π ! k)"
using encode_problem_serializable_sound(2)[OF assms(1, 2)] k_lt_length_π
by blast
ultimately have "are_all_operators_applicable (?τ ! k) (?π ! k)"
and "are_all_operator_effects_consistent (?π ! k)"
and "are_all_operators_non_interfering (?π ! k)"
by blast+
}
ultimately show ?thesis
using execute_parallel_plan_is_execute_sequential_plan_if assms(1)
by metis
qed
lemma encode_problem_forall_step_decoded_plan_is_serializable_ii:
fixes Π :: "'variable strips_problem"
shows "list_all (λop. ListMem op (strips_problem.operators_of Π))
(concat (Φ¯ Π 𝒜 t))"
proof -
let ?π = "Φ¯ Π 𝒜 t"
let ?π' = "concat ?π"
{
have "set ?π' = ⋃(set ` (⋃k < t. { decode_plan' Π 𝒜 k }))"
unfolding decode_plan_def decode_plan_set_is set_concat
by auto
also have "… = ⋃(⋃k < t. { set (decode_plan' Π 𝒜 k) })"
by blast
finally have "set ?π' = (⋃k < t. set (decode_plan' Π 𝒜 k))"
by blast
} note nb = this
{
fix op
assume "op ∈ set ?π'"
then obtain k where "k < t" and "op ∈ set (decode_plan' Π 𝒜 k)"
using nb
by blast
moreover have "op ∈ set (decode_plan Π 𝒜 t ! k)"
using calculation
unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
by simp
ultimately have "op ∈ set (operators_of Π)"
using decode_plan_step_element_then(1)
unfolding operators_of_def decode_plan_def
by blast
}
thus ?thesis
unfolding list_all_iff ListMem_iff operators_of_def
by blast
qed
text ‹ Given the soundness and completeness of the SATPlan encoding with interfering operator
exclusion \<^term>‹Φ⇩∀ Π t›, we can
now conclude this part with showing that for a parallel plan \<^term>‹π ≡ Φ¯ Π 𝒜 t›
that was decoded from a model \<^term>‹𝒜› of \<^term>‹Φ⇩∀ Π t› the serialized plan
\<^term>‹π' ≡ concat π› is a serial solution for \<^term>‹Π›. To this end, we have to show that
\begin{itemize}
\item the state reached by serial execution of \<^term>‹π'› subsumes \<^term>‹G›, and
\item all operators in \<^term>‹π'› are operators contained in \<^term>‹𝒪›.
\end{itemize}
While the proof of the latter step is rather straight forward, the proof for the
former requires a bit more work. We use the previously established theorem on serial and parallel
STRIPS equivalence (theorem \ref{isathm:equivalence-parallel-serial-strips-plans}) to show the
serializability of \<^term>‹π› and therefore have to show that \<^term>‹G› is subsumed by the last state
of the trace of \<^term>‹π'›
@{text[display, indent=4] "G ⊆⇩m last (trace_sequential_plan_strips I π')"}
and moreover that at every step of the parallel plan execution, the parallel operator execution
condition as well as non interference are met
@{text[display, indent=4] "∀k < length π. are_all_operators_non_interfering (π ! k)"}.
\footnote{These propositions are shown in lemmas \texttt{encode\_problem\_forall\_step\_decoded\_plan\_is\_serializable\_ii} and
\texttt{encode\_problem\_forall\_step\_decoded\_plan\_is\_serializable\_i} which have been omitted for
brevity.}
Note that the parallel operator execution condition is implicit in the existence of the parallel
trace for \<^term>‹π› with
@{text[display, indent=4] "G ⊆⇩m last (trace_parallel_plan_strips I π)"}
warranted by the soundness of \<^term>‹Φ⇩∀ Π t›. ›
theorem serializable_encoding_decoded_plan_is_serializable:
assumes "is_valid_problem_strips Π"
and "𝒜 ⊨ Φ⇩∀ Π t"
shows "is_serial_solution_for_problem Π (concat (Φ¯ Π 𝒜 t))"
using encode_problem_forall_step_decoded_plan_is_serializable_i[OF assms]
encode_problem_forall_step_decoded_plan_is_serializable_ii
unfolding is_serial_solution_for_problem_def goal_of_def
initial_of_def decode_plan_def
by blast
end
Theory SAT_Solve_SAS_Plus
theory SAT_Solve_SAS_Plus
imports "SAS_Plus_STRIPS"
"SAT_Plan_Extensions"
begin
section "SAT-Solving of SAS+ Problems"
lemma sas_plus_problem_has_serial_solution_iff_i:
assumes "is_valid_problem_sas_plus Ψ"
and "𝒜 ⊨ Φ⇩∀ (φ Ψ) t"
shows "is_serial_solution_for_problem Ψ [φ⇩O¯ Ψ op. op ← concat (Φ¯ (φ Ψ) 𝒜 t)]"
proof -
let ?Π = "φ Ψ"
and ?π' = "concat (Φ¯ (φ Ψ) 𝒜 t)"
let ?ψ = "[φ⇩O¯ Ψ op. op ← ?π']"
{
have "is_valid_problem_strips ?Π"
using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
moreover have "STRIPS_Semantics.is_serial_solution_for_problem ?Π ?π'"
using calculation serializable_encoding_decoded_plan_is_serializable[OF
_ assms(2)]
unfolding decode_plan_def
by simp
ultimately have "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ?ψ"
using assms(1) serial_strips_equivalent_to_serial_sas_plus
by blast
}
thus ?thesis
using serial_strips_equivalent_to_serial_sas_plus[OF assms(1)]
by blast
qed
lemma sas_plus_problem_has_serial_solution_iff_ii:
assumes "is_valid_problem_sas_plus Ψ"
and "is_serial_solution_for_problem Ψ ψ"
and "h = length ψ"
shows "∃𝒜. (𝒜 ⊨ Φ⇩∀ (φ Ψ) h)"
proof -
let ?Π = "φ Ψ"
and ?π = "φ⇩P Ψ (embed ψ)"
let ?𝒜 = "valuation_for_plan ?Π ?π"
let ?t = "length ψ"
have nb: "length ψ = length ?π"
unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
sas_plus_parallel_plan_to_strips_parallel_plan_def
by (induction ψ; auto)
have "is_valid_problem_strips ?Π"
using assms(1) is_valid_problem_sas_plus_then_strips_transformation_too
by blast
moreover have "STRIPS_Semantics.is_parallel_solution_for_problem ?Π ?π"
using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus[OF assms(1,2)]
strips_equivalent_to_sas_plus[OF assms(1)]
by blast
moreover {
fix k
assume "k < length ?π"
moreover obtain ops' where "ops' = ?π ! k"
by simp
moreover have "ops' ∈ set ?π"
using calculation nth_mem
by blast
moreover have "?π = [[φ⇩O Ψ op. op ← ops]. ops ← embed ψ]"
unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
sasp_op_to_strips_def
sas_plus_parallel_plan_to_strips_parallel_plan_def
..
moreover obtain ops
where "ops' = [φ⇩O Ψ op. op ← ops]"
and "ops ∈ set (embed ψ)"
using calculation(3, 4)
by auto
moreover have "ops ∈ { [op] | op. op ∈ set ψ }"
using calculation(6) set_of_embed_is
by blast
moreover obtain op
where "ops = [op]" and "op ∈ set ψ"
using calculation(7)
by blast
ultimately have "are_all_operators_non_interfering (?π ! k)"
by fastforce
}
ultimately show ?thesis
using encode_problem_serializable_complete nb
by (auto simp: assms(3))
qed
text ‹ To wrap-up our documentation of the Isabelle formalization, we take a look at the central
theorem which combines all the previous theorem to show that SAS+ problems \<^term>‹Ψ› can be solved
using the planning as satisfiability framework.
A solution \<^term>‹ψ› for the SAS+ problem \<^term>‹Ψ› exists if and only if a model \<^term>‹𝒜› and a
hypothesized plan length \<^term>‹t› exist s.t.
@{text[display,indent=4] "𝒜 ⊨ Φ⇩∀ (φ Ψ) t"}
for the serializable SATPlan encoding of the corresponding STRIPS problem \<^term>‹Φ⇩∀ (φ Ψ) t› exist. ›
theorem sas_plus_problem_has_serial_solution_iff:
assumes "is_valid_problem_sas_plus Ψ"
shows "(∃ψ. is_serial_solution_for_problem Ψ ψ) ⟷ (∃𝒜 t. 𝒜 ⊨ Φ⇩∀ (φ Ψ) t)"
using sas_plus_problem_has_serial_solution_iff_i[OF assms]
sas_plus_problem_has_serial_solution_iff_ii[OF assms]
by blast
section ‹Adding Noop actions to the SAS+ problem›
text ‹Here we add noop actions to the SAS+ problem to enable the SAT formula to be satisfiable if
there are plans that are shorter than the given horizons.›
definition "empty_sasp_action ≡ ⦇SAS_Plus_Representation.sas_plus_operator.precondition_of = [],
SAS_Plus_Representation.sas_plus_operator.effect_of = []⦈"
lemma sasp_exec_noops: "execute_serial_plan_sas_plus s (replicate n empty_sasp_action) = s"
by (induction n arbitrary: )
(auto simp: empty_sasp_action_def STRIPS_Representation.is_operator_applicable_in_def
execute_operator_def)
definition
"prob_with_noop Π ≡
⦇SAS_Plus_Representation.sas_plus_problem.variables_of = SAS_Plus_Representation.sas_plus_problem.variables_of Π,
SAS_Plus_Representation.sas_plus_problem.operators_of = empty_sasp_action # SAS_Plus_Representation.sas_plus_problem.operators_of Π,
SAS_Plus_Representation.sas_plus_problem.initial_of = SAS_Plus_Representation.sas_plus_problem.initial_of Π,
SAS_Plus_Representation.sas_plus_problem.goal_of = SAS_Plus_Representation.sas_plus_problem.goal_of Π,
SAS_Plus_Representation.sas_plus_problem.range_of = SAS_Plus_Representation.sas_plus_problem.range_of Π⦈"
lemma sasp_noops_in_noop_problem: "set (replicate n empty_sasp_action) ⊆ set (SAS_Plus_Representation.sas_plus_problem.operators_of (prob_with_noop Π))"
by (induction n) (auto simp: prob_with_noop_def)
lemma noops_complete:
"SAS_Plus_Semantics.is_serial_solution_for_problem Ψ π ⟹
SAS_Plus_Semantics.is_serial_solution_for_problem (prob_with_noop Ψ) ((replicate n empty_sasp_action) @ π)"
by(induction n)
(auto simp: SAS_Plus_Semantics.is_serial_solution_for_problem_def insert list.pred_set
sasp_exec_noops prob_with_noop_def Let_def empty_sasp_action_def elem)
definition "rem_noops ≡ filter (λop. op ≠ empty_sasp_action)"
lemma sasp_filter_empty_action:
"execute_serial_plan_sas_plus s (rem_noops πs) = execute_serial_plan_sas_plus s πs"
by (induction πs arbitrary: s)
(auto simp: empty_sasp_action_def rem_noops_def)
lemma noops_sound:
"SAS_Plus_Semantics.is_serial_solution_for_problem (prob_with_noop Ψ) πs ⟹
SAS_Plus_Semantics.is_serial_solution_for_problem Ψ (rem_noops πs)"
by(induction πs)
(fastforce simp: SAS_Plus_Semantics.is_serial_solution_for_problem_def insert list.pred_set
prob_with_noop_def ListMem_iff rem_noops_def
sasp_filter_empty_action[unfolded empty_sasp_action_def rem_noops_def]
empty_sasp_action_def)+
lemma noops_valid: "is_valid_problem_sas_plus Ψ ⟹ is_valid_problem_sas_plus (prob_with_noop Ψ)"
by (auto simp: is_valid_problem_sas_plus_def prob_with_noop_def Let_def
empty_sasp_action_def is_valid_operator_sas_plus_def list.pred_set)
lemma sas_plus_problem_has_serial_solution_iff_i':
assumes "is_valid_problem_sas_plus Ψ"
and "𝒜 ⊨ Φ⇩∀ (φ (prob_with_noop Ψ)) t"
shows "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ
(rem_noops
(map (λop. φ⇩O¯ (prob_with_noop Ψ) op)
(concat (Φ¯ (φ (prob_with_noop Ψ)) 𝒜 t))))"
using assms noops_valid
by(force intro!: noops_sound sas_plus_problem_has_serial_solution_iff_i)
lemma sas_plus_problem_has_serial_solution_iff_ii':
assumes "is_valid_problem_sas_plus Ψ"
and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ"
and "length ψ ≤ h"
shows "∃𝒜. (𝒜 ⊨ Φ⇩∀ (φ (prob_with_noop Ψ)) h)"
using assms
by(fastforce
intro!: assms noops_valid noops_complete
sas_plus_problem_has_serial_solution_iff_ii
[where ψ = "(replicate (h - length ψ) empty_sasp_action) @ ψ"] )
end
Theory AST_SAS_Plus_Equivalence
theory AST_SAS_Plus_Equivalence
imports "AI_Planning_Languages_Semantics.SASP_Semantics" "SAS_Plus_Semantics" "List-Index.List_Index"
begin
section ‹Proving Equivalence of SAS+ representation and Fast-Downward's Multi-Valued Problem
Representation›
subsection ‹Translating Fast-Downward's represnetation to SAS+›
type_synonym nat_sas_plus_problem = "(nat, nat) sas_plus_problem"
type_synonym nat_sas_plus_operator = "(nat, nat) sas_plus_operator"
type_synonym nat_sas_plus_plan = "(nat, nat) sas_plus_plan"
type_synonym nat_sas_plus_state = "(nat, nat) state"
definition is_standard_effect :: "ast_effect ⇒ bool"
where "is_standard_effect ≡ λ(pre, _, _, _). pre = []"
definition is_standard_operator :: "ast_operator ⇒ bool"
where "is_standard_operator ≡ λ(_, _, effects, _). list_all is_standard_effect effects"
fun rem_effect_implicit_pres:: "ast_effect ⇒ ast_effect" where
"rem_effect_implicit_pres (preconds, v, implicit_pre, eff) = (preconds, v, None, eff)"
fun rem_implicit_pres :: "ast_operator ⇒ ast_operator" where
"rem_implicit_pres (name, preconds, effects, cost) =
(name, (implicit_pres effects) @ preconds, map rem_effect_implicit_pres effects, cost)"
fun rem_implicit_pres_ops :: "ast_problem ⇒ ast_problem" where
"rem_implicit_pres_ops (vars, init, goal, ops) = (vars, init, goal, map rem_implicit_pres ops)"
definition "consistent_map_lists xs1 xs2 ≡ (∀(x1,x2) ∈ set xs1. ∀(y1,y2)∈ set xs2. x1 = y1 ⟶ x1 = y2)"
lemma map_add_comm: "(⋀x. x ∈ dom m1 ∧ x ∈ dom m2 ⟹ m1 x = m2 x) ⟹ m1 ++ m2 = m2 ++ m1"
by (fastforce simp add: map_add_def split: option.splits)
lemma first_map_add_submap: "(⋀x. x ∈ dom m1 ∧ x ∈ dom m2 ⟹ m1 x = m2 x) ⟹
m1 ++ m2 ⊆⇩m x ⟹ m1 ⊆⇩m x"
using map_add_le_mapE map_add_comm
by force
lemma subsuming_states_map_add:
"(⋀x. x ∈ dom m1 ∩ dom m2 ⟹ m1 x = m2 x) ⟹
m1 ++ m2 ⊆⇩m s ⟷ (m1 ⊆⇩m s ∧ m2 ⊆⇩m s)"
by(auto simp: map_add_le_mapI intro: first_map_add_submap map_add_le_mapE)
lemma consistent_map_lists:
"⟦distinct (map fst (xs1 @ xs2)); x ∈ dom (map_of xs1) ∩ dom (map_of xs2)⟧ ⟹
(map_of xs1) x = (map_of xs2) x"
apply(induction xs1)
apply (simp_all add: consistent_map_lists_def image_def)
using map_of_SomeD
by fastforce
lemma subsuming_states_append:
"distinct (map fst (xs @ ys)) ⟹
(map_of (xs @ ys)) ⊆⇩m s ⟷ ((map_of ys) ⊆⇩m s ∧ (map_of xs) ⊆⇩m s)"
unfolding map_of_append
apply(intro subsuming_states_map_add)
apply (auto simp add: image_def)
by (metis (mono_tags, lifting) IntI empty_iff fst_conv mem_Collect_eq)
definition consistent_pres_op where
"consistent_pres_op op ≡ (case op of (name, pres, effs, cost) ⇒
distinct (map fst (pres @ (implicit_pres effs)))
∧ consistent_map_lists pres (implicit_pres effs))"
definition consistent_pres_op' where
"consistent_pres_op' op ≡ (case op of (name, pres, effs, cost) ⇒
consistent_map_lists pres (implicit_pres effs))"
lemma consistent_pres_op_then': "consistent_pres_op op ⟹ consistent_pres_op' op"
by(auto simp add: consistent_pres_op'_def consistent_pres_op_def)
lemma rem_implicit_pres_ops_valid_states:
"ast_problem.valid_states (rem_implicit_pres_ops prob) = ast_problem.valid_states prob"
apply(cases prob)
by(auto simp add: ast_problem.valid_states_def ast_problem.Dom_def
ast_problem.numVars_def ast_problem.astDom_def
ast_problem.range_of_var_def ast_problem.numVals_def)
lemma rem_implicit_pres_ops_lookup_op_None:
"ast_problem.lookup_operator (vars, init, goal, ops) name = None ⟷
ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name = None"
by (induction ops) (auto simp: ast_problem.lookup_operator_def ast_problem.astδ_def)
lemma rem_implicit_pres_ops_lookup_op_Some_1:
"ast_problem.lookup_operator (vars, init, goal, ops) name = Some (n,p,vp,e) ⟹
ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name =
Some (rem_implicit_pres (n,p,vp,e))"
by (induction ops) (fastforce simp: ast_problem.lookup_operator_def ast_problem.astδ_def)+
lemma rem_implicit_pres_ops_lookup_op_Some_1':
"ast_problem.lookup_operator prob name = Some (n,p,vp,e) ⟹
ast_problem.lookup_operator (rem_implicit_pres_ops prob) name =
Some (rem_implicit_pres (n,p,vp,e))"
apply(cases prob)
using rem_implicit_pres_ops_lookup_op_Some_1
by simp
lemma implicit_pres_empty: "implicit_pres (map rem_effect_implicit_pres effs) = []"
by (induction effs) (auto simp: implicit_pres_def)
lemma rem_implicit_pres_ops_lookup_op_Some_2:
"ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name = Some op
⟹ ∃op'. ast_problem.lookup_operator (vars, init, goal, ops) name = Some op' ∧
(op = rem_implicit_pres op')"
by (induction ops) (auto simp: ast_problem.lookup_operator_def ast_problem.astδ_def implicit_pres_empty image_def)
lemma rem_implicit_pres_ops_lookup_op_Some_2':
"ast_problem.lookup_operator (rem_implicit_pres_ops prob) name = Some (n,p,e,c)
⟹ ∃op'. ast_problem.lookup_operator prob name = Some op' ∧
((n,p,e,c) = rem_implicit_pres op')"
apply(cases prob)
using rem_implicit_pres_ops_lookup_op_Some_2
by auto
lemma subsuming_states_def':
"s ∈ ast_problem.subsuming_states prob ps = (s ∈ (ast_problem.valid_states prob) ∧ ps ⊆⇩m s)"
by (auto simp add: ast_problem.subsuming_states_def)
lemma rem_implicit_pres_ops_enabled_1:
"⟦(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op);
ast_problem.enabled prob name s⟧ ⟹
ast_problem.enabled (rem_implicit_pres_ops prob) name s"
by (fastforce simp: ast_problem.enabled_def rem_implicit_pres_ops_valid_states subsuming_states_def'
implicit_pres_empty
intro!: map_add_le_mapI
dest: rem_implicit_pres_ops_lookup_op_Some_1'
split: option.splits)+
context ast_problem
begin
lemma lookup_Some_inδ: "lookup_operator π = Some op ⟹ op∈set astδ"
by(auto simp: find_Some_iff in_set_conv_nth lookup_operator_def)
end
lemma rem_implicit_pres_ops_enabled_2:
assumes "(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op)"
shows "ast_problem.enabled (rem_implicit_pres_ops prob) name s ⟹
ast_problem.enabled prob name s"
using assms[OF ast_problem.lookup_Some_inδ, unfolded consistent_pres_op_def]
apply(auto simp: subsuming_states_append rem_implicit_pres_ops_valid_states subsuming_states_def'
ast_problem.enabled_def
dest!: rem_implicit_pres_ops_lookup_op_Some_2'
split: option.splits)
using subsuming_states_map_add consistent_map_lists
apply (metis Map.map_add_comm dom_map_of_conv_image_fst map_add_le_mapE)
using map_add_le_mapE by blast
lemma rem_implicit_pres_ops_enabled:
"(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op) ⟹
ast_problem.enabled (rem_implicit_pres_ops prob) name s = ast_problem.enabled prob name s"
using rem_implicit_pres_ops_enabled_1 rem_implicit_pres_ops_enabled_2
by blast
context ast_problem
begin
lemma std_eff_enabled[simp]:
"is_standard_operator (name, pres, effs, layer) ⟹ s ∈ valid_states ⟹ (filter (eff_enabled s) effs) = effs"
by (induction effs) (auto simp: is_standard_operator_def is_standard_effect_def eff_enabled_def subsuming_states_def)
end
lemma is_standard_operator_rem_implicit: "is_standard_operator (n,p,vp,v) ⟹
is_standard_operator (rem_implicit_pres (n,p,vp,v))"
by (induction vp) (auto simp: is_standard_operator_def is_standard_effect_def)
lemma is_standard_operator_rem_implicit_pres_ops:
"⟦(⋀op. op ∈ set (ast_problem.astδ (a,b,c,d)) ⟹ is_standard_operator op);
op ∈ set (ast_problem.astδ (rem_implicit_pres_ops (a,b,c,d)))⟧
⟹ is_standard_operator op"
by (induction d) (fastforce simp add: ast_problem.astδ_def image_def dest!: is_standard_operator_rem_implicit)+
lemma is_standard_operator_rem_implicit_pres_ops':
"⟦op ∈ set (ast_problem.astδ (rem_implicit_pres_ops prob));
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ is_standard_operator op)⟧
⟹ is_standard_operator op"
apply(cases prob)
using is_standard_operator_rem_implicit_pres_ops
by blast
lemma in_rem_implicit_pres_δ:
"op ∈ set (ast_problem.astδ prob) ⟹
rem_implicit_pres op ∈ set (ast_problem.astδ (rem_implicit_pres_ops prob))"
by(auto simp add: ast_problem.astδ_def)
lemma rem_implicit_pres_ops_execute:
assumes
"(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ is_standard_operator op)" and
"s ∈ ast_problem.valid_states prob"
shows "ast_problem.execute (rem_implicit_pres_ops prob) name s = ast_problem.execute prob name s"
proof-
have "(n,ps,es,c) ∈ set (ast_problem.astδ prob) ⟹
(filter (ast_problem.eff_enabled prob s) es) = es" for n ps es c
using assms(2)
by (auto simp add: ast_problem.std_eff_enabled dest!: assms(1))
moreover have "(n,ps,es,c) ∈ set (ast_problem.astδ prob) ⟹
(filter (ast_problem.eff_enabled (rem_implicit_pres_ops prob) s) (map rem_effect_implicit_pres es))
= map rem_effect_implicit_pres es" for n ps es c
using assms
by (fastforce simp add: ast_problem.std_eff_enabled rem_implicit_pres_ops_valid_states
dest!: is_standard_operator_rem_implicit_pres_ops'
dest: in_rem_implicit_pres_δ)
moreover have "map_of (map ((λ(_,x,_,v). (x,v)) o rem_effect_implicit_pres) effs) =
map_of (map (λ(_,x,_,v). (x,v)) effs)" for effs
by (induction effs) auto
ultimately show ?thesis
by(auto simp add: ast_problem.execute_def rem_implicit_pres_ops_lookup_op_Some_1'
split: option.splits
dest: rem_implicit_pres_ops_lookup_op_Some_2' ast_problem.lookup_Some_inδ)
qed
lemma rem_implicit_pres_ops_path_to:
"wf_ast_problem prob ⟹
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op) ⟹
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ is_standard_operator op) ⟹
s ∈ ast_problem.valid_states prob ⟹
ast_problem.path_to (rem_implicit_pres_ops prob) s πs s' = ast_problem.path_to prob s πs s'"
by (induction πs arbitrary: s)
(auto simp: rem_implicit_pres_ops_execute rem_implicit_pres_ops_enabled
ast_problem.path_to.simps wf_ast_problem.execute_preserves_valid)
lemma rem_implicit_pres_ops_astG[simp]: "ast_problem.astG (rem_implicit_pres_ops prob) =
ast_problem.astG prob"
apply(cases prob)
by (auto simp add: ast_problem.astG_def)
lemma rem_implicit_pres_ops_goal[simp]: "ast_problem.G (rem_implicit_pres_ops prob) = ast_problem.G prob"
apply(cases prob)
using rem_implicit_pres_ops_valid_states
by (auto simp add: ast_problem.G_def ast_problem.astG_def subsuming_states_def')
lemma rem_implicit_pres_ops_astI[simp]:
"ast_problem.astI (rem_implicit_pres_ops prob) = ast_problem.astI prob"
apply(cases prob)
by (auto simp add: ast_problem.I_def ast_problem.astI_def subsuming_states_def')
lemma rem_implicit_pres_ops_init[simp]: "ast_problem.I (rem_implicit_pres_ops prob) = ast_problem.I prob"
apply(cases prob)
by (auto simp add: ast_problem.I_def ast_problem.astI_def)
lemma rem_implicit_pres_ops_valid_plan:
assumes "wf_ast_problem prob"
"(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op)"
"(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ is_standard_operator op)"
shows "ast_problem.valid_plan (rem_implicit_pres_ops prob) πs = ast_problem.valid_plan prob πs"
using wf_ast_problem.I_valid[OF assms(1)] rem_implicit_pres_ops_path_to[OF assms]
by (simp add: ast_problem.valid_plan_def rem_implicit_pres_ops_goal rem_implicit_pres_ops_init)
lemma rem_implicit_pres_ops_numVars[simp]:
"ast_problem.numVars (rem_implicit_pres_ops prob) = ast_problem.numVars prob"
by (cases prob) (simp add: ast_problem.numVars_def ast_problem.astDom_def)
lemma rem_implicit_pres_ops_numVals[simp]:
"ast_problem.numVals (rem_implicit_pres_ops prob) x = ast_problem.numVals prob x"
by (cases prob) (simp add: ast_problem.numVals_def ast_problem.astDom_def)
lemma in_implicit_pres:
"(x, a) ∈ set (implicit_pres effs) ⟹ (∃epres v vp. (epres,x,vp,v)∈ set effs ∧ vp = Some a)"
by (induction effs) (fastforce simp: implicit_pres_def image_def split: if_splits)+
lemma pair4_eqD: "(a1,a2,a3,a4) = (b1,b2,b3,b4) ⟹ a3 = b3"
by simp
lemma rem_implicit_pres_ops_wf_partial_state:
"ast_problem.wf_partial_state (rem_implicit_pres_ops prob) s =
ast_problem.wf_partial_state prob s"
by (auto simp: ast_problem.wf_partial_state_def)
lemma rem_implicit_pres_wf_operator:
assumes "consistent_pres_op op"
"ast_problem.wf_operator prob op"
shows
"ast_problem.wf_operator (rem_implicit_pres_ops prob) (rem_implicit_pres op)"
proof-
obtain name pres effs cost where op: "op = (name, pres, effs, cost)"
by (cases op)
hence asses: "consistent_pres_op (name, pres, effs, cost)"
"ast_problem.wf_operator prob (name, pres, effs, cost)"
using assms
by auto
hence "distinct (map fst ((implicit_pres effs) @ pres))"
by (simp only: consistent_pres_op_def) auto
moreover have "x < ast_problem.numVars (rem_implicit_pres_ops prob)"
"v < ast_problem.numVals (rem_implicit_pres_ops prob) x"
if "(x,v) ∈ set ((implicit_pres effs) @ pres)" for x v
using that asses
by (auto dest!: in_implicit_pres simp: ast_problem.wf_partial_state_def ast_problem.wf_operator_def)
ultimately have "ast_problem.wf_partial_state (rem_implicit_pres_ops prob) ((implicit_pres effs) @ pres)"
by (auto simp only: ast_problem.wf_partial_state_def)
moreover have "(map (λ(_, v, _, _). v) effs) =
(map (λ(_, v, _, _). v) (map rem_effect_implicit_pres effs))"
by auto
hence "distinct (map (λ(_, v, _, _). v) (map rem_effect_implicit_pres effs))"
using assms(2)
by (auto simp only: op ast_problem.wf_operator_def rem_implicit_pres.simps dest!: pair4_eqD)
moreover have "(∃vp. (epres,x,vp,v)∈set effs) ⟷ (epres,x,None,v)∈set (map rem_effect_implicit_pres effs)"
for epres x v
by force
ultimately show ?thesis
using assms(2)
by (auto simp: op ast_problem.wf_operator_def rem_implicit_pres_ops_wf_partial_state
split: prod.splits)
qed
lemma rem_implicit_pres_ops_inδD: "op ∈ set (ast_problem.astδ (rem_implicit_pres_ops prob))
⟹ (∃op'. op' ∈ set (ast_problem.astδ prob) ∧ op = rem_implicit_pres op')"
by (cases prob) (force simp: ast_problem.astδ_def)
lemma rem_implicit_pres_ops_well_formed:
assumes "(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op)"
"ast_problem.well_formed prob"
shows "ast_problem.well_formed (rem_implicit_pres_ops prob)"
proof-
have "map fst (ast_problem.astδ (rem_implicit_pres_ops prob)) = map fst (ast_problem.astδ prob)"
by (cases prob) (auto simp: ast_problem.astδ_def)
thus ?thesis
using assms
by(auto simp add: ast_problem.well_formed_def rem_implicit_pres_ops_wf_partial_state
simp del: rem_implicit_pres.simps
dest!: rem_implicit_pres_ops_inδD
intro!: rem_implicit_pres_wf_operator)
qed
definition is_standard_effect'
:: "ast_effect ⇒ bool"
where "is_standard_effect' ≡ λ(pre, _, vpre, _). pre = [] ∧ vpre = None"
definition is_standard_operator'
:: "ast_operator ⇒ bool"
where "is_standard_operator' ≡ λ(_, _, effects, _). list_all is_standard_effect' effects"
lemma rem_implicit_pres_is_standard_operator':
"is_standard_operator (n,p,es,c) ⟹ is_standard_operator' (rem_implicit_pres (n,p,es,c))"
by (induction es) (auto simp: is_standard_operator'_def is_standard_operator_def is_standard_effect_def
is_standard_effect'_def)
lemma rem_implicit_pres_ops_is_standard_operator':
"(⋀op. op ∈ set (ast_problem.astδ (vs, I, G, ops)) ⟹ is_standard_operator op) ⟹
π∈set (ast_problem.astδ (rem_implicit_pres_ops (vs, I, G, ops))) ⟹ is_standard_operator' π"
by (cases ops) (auto simp: ast_problem.astδ_def dest!: rem_implicit_pres_is_standard_operator')
locale abs_ast_prob = wf_ast_problem +
assumes no_cond_effs: "∀π∈set astδ. is_standard_operator' π"
context ast_problem
begin
definition "abs_ast_variable_section = [0..<(length astDom)]"
definition abs_range_map
:: "(nat ⇀ nat list)"
where "abs_range_map ≡
map_of (zip abs_ast_variable_section
(map ((λvals. [0..<length vals]) o snd o snd)
astDom))"
end
context abs_ast_prob
begin
lemma is_valid_vars_1: "astDom ≠ [] ⟹ abs_ast_variable_section ≠ []"
by(simp add: abs_ast_variable_section_def)
end
lemma upt_eq_Nil_conv'[simp]: "([] = [i..<j]) = (j = 0 ∨ j ≤ i)"
by(induct j)simp_all
lemma map_of_zip_map_Some:
"v < length xs
⟹ (map_of (zip [0..<length xs] (map f xs)) v) = Some (f (xs ! v))"
by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)
lemma map_of_zip_Some:
"v < length xs
⟹ (map_of (zip [0..<length xs] xs) v) = Some (xs ! v)"
by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)
lemma in_set_zip_lengthE:
"(x,y) ∈ set(zip [0..<length xs] xs) ⟹ (⟦ x < length xs; xs ! x =y ⟧ ⟹ R) ⟹ R"
by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)
context abs_ast_prob
begin
lemma is_valid_vars_2:
shows "list_all (λv. abs_range_map v ≠ None) abs_ast_variable_section"
by (auto simp add: abs_range_map_def abs_ast_variable_section_def list.pred_set)
end
context ast_problem
begin
definition abs_ast_initial_state
:: "nat_sas_plus_state"
where "abs_ast_initial_state ≡ map_of (zip [0..<length astI] astI)"
end
context abs_ast_prob
begin
lemma valid_abs_init_1: "abs_ast_initial_state v ≠ None ⟷ v ∈ set abs_ast_variable_section"
by (simp add: abs_ast_variable_section_def numVars_def wf_initial(1) abs_ast_initial_state_def)
lemma abs_range_map_Some:
shows "v ∈ set abs_ast_variable_section ⟹
(abs_range_map v) = Some [0..<length (snd (snd (astDom ! v)))]"
by (simp add: numVars_def abs_range_map_def o_def abs_ast_variable_section_def map_of_zip_map_Some)
lemma in_abs_v_sec_length: "v ∈ set abs_ast_variable_section ⟷ v < length astDom"
by (simp add: abs_ast_variable_section_def)
lemma [simp]: "v < length astDom ⟹ (abs_ast_initial_state v) = Some (astI ! v)"
using wf_initial(1)[simplified numVars_def, symmetric]
by (auto simp add: map_of_zip_Some abs_ast_initial_state_def split: prod.splits)
lemma [simp]: "v < length astDom ⟹ astI ! v < length (snd (snd (astDom ! v)))"
using wf_initial(1)[simplified numVars_def, symmetric] wf_initial
by (auto simp add: numVals_def abs_ast_initial_state_def
split: prod.splits)
lemma [intro!]: "v ∈ set abs_ast_variable_section ⟹ x < length (snd (snd (astDom ! v))) ⟹
x ∈ set (the (abs_range_map v))"
using abs_range_map_Some
by (auto simp add: )
lemma [intro!]: "x<length astDom ⟹ astI ! x < length (snd (snd (astDom ! x)))"
using wf_initial[unfolded numVars_def numVals_def]
by auto
lemma [simp]: "abs_ast_initial_state v = Some a ⟹ a < length (snd (snd (astDom ! v)))"
by(auto simp add: abs_ast_initial_state_def
wf_initial(1)[unfolded numVars_def numVals_def, symmetric]
elim!: in_set_zip_lengthE)
lemma valid_abs_init_2:
"abs_ast_initial_state v ≠ None ⟹ (the (abs_ast_initial_state v)) ∈ set (the (abs_range_map v))"
using valid_abs_init_1
by auto
end
context ast_problem
begin
definition abs_ast_goal
:: "nat_sas_plus_state"
where "abs_ast_goal ≡ map_of astG"
end
context abs_ast_prob
begin
lemma [simp]: "wf_partial_state s ⟹ (v, a) ∈ set s ⟹ v ∈ set abs_ast_variable_section"
by (auto simp add: wf_partial_state_def abs_ast_variable_section_def numVars_def
split: prod.splits)
lemma valid_abs_goal_1: "abs_ast_goal v ≠ None ⟹ v ∈ set abs_ast_variable_section"
using wf_goal
by (auto simp add: abs_ast_goal_def dest!: map_of_SomeD)
lemma in_abs_rangeI: "wf_partial_state s ⟹ (v, a) ∈ set s ⟹ (a ∈ set (the (abs_range_map v)))"
by (auto simp add: abs_range_map_Some wf_partial_state_def numVals_def split: prod.splits)
lemma valid_abs_goal_2:
"abs_ast_goal v ≠ None ⟹ (the (abs_ast_goal v)) ∈ set (the (abs_range_map v))"
using wf_goal
by (auto simp add: map_of_SomeD weak_map_of_SomeI abs_ast_goal_def intro!: in_abs_rangeI)
end
context ast_problem
begin
definition abs_ast_operator
:: "ast_operator ⇒ nat_sas_plus_operator"
where "abs_ast_operator ≡ λ(name, preconditions, effects, cost).
⦇ precondition_of = preconditions,
effect_of = [(v, x). (_, v, _, x) ← effects] ⦈"
end
context abs_ast_prob
begin
lemma abs_rangeI: "wf_partial_state s ⟹ (v, a) ∈ set s ⟹ (abs_range_map v ≠ None)"
by (auto simp add: wf_partial_state_def abs_range_map_def abs_ast_variable_section_def list.pred_set
numVars_def
split: prod.splits)
lemma abs_valid_operator_1[intro!]:
"wf_operator op ⟹ list_all (λ(v, a). ListMem v abs_ast_variable_section)
(precondition_of (abs_ast_operator op))"
by (cases op; auto simp add: abs_ast_operator_def wf_operator_def list.pred_set ListMem_iff)
lemma wf_operator_preD: "wf_operator (name, pres, effs, cost) ⟹ wf_partial_state pres"
by (simp add: wf_operator_def)
lemma abs_valid_operator_2[intro!]:
"wf_operator op ⟹
list_all (λ(v, a). (∃y. abs_range_map v = Some y) ∧ ListMem a (the (abs_range_map v)))
(precondition_of (abs_ast_operator op))"
by(cases op,
auto dest!: wf_operator_preD simp: list.pred_set ListMem_iff abs_ast_operator_def
intro!: abs_rangeI[simplified not_None_eq] in_abs_rangeI)
lemma wf_operator_effE: "wf_operator (name, pres, effs, cost) ⟹
(⟦distinct (map (λ(_, v, _, _). v) effs);
⋀epres x vp v. (epres,x,vp,v)∈set effs ⟹ wf_partial_state epres;
⋀epres x vp v.(epres,x,vp,v)∈set effs ⟹ x < numVars;
⋀epres x vp v. (epres,x,vp,v)∈set effs ⟹ v < numVals x;
⋀epres x vp v. (epres,x,vp,v)∈set effs ⟹
case vp of None ⇒ True | Some v ⇒ v<numVals x⟧
⟹ P)
⟹ P"
unfolding wf_operator_def
by (auto split: prod.splits)
lemma abs_valid_operator_3':
"wf_operator (name, pre, eff, cost) ⟹
list_all (λ(v, a). ListMem v abs_ast_variable_section) (map (λ(_, v, _, a). (v, a)) eff)"
by (fastforce simp add: list.pred_set ListMem_iff abs_ast_variable_section_def image_def numVars_def
elim!: wf_operator_effE split: prod.splits)
lemma abs_valid_operator_3[intro!]:
"wf_operator op ⟹
list_all (λ(v, a). ListMem v abs_ast_variable_section) (effect_of (abs_ast_operator op))"
by (cases op, simp add: abs_ast_operator_def abs_valid_operator_3')
lemma wf_abs_eff: "wf_operator (name, pre, eff, cost) ⟹ wf_partial_state (map (λ(_, v, _, a). (v, a)) eff)"
by (elim wf_operator_effE, induction eff)
(fastforce simp: wf_partial_state_def image_def o_def split: prod.split_asm)+
lemma abs_valid_operator_4':
"wf_operator (name, pre, eff, cost) ⟹
list_all (λ(v, a). (abs_range_map v ≠ None) ∧ ListMem a (the (abs_range_map v))) (map (λ(_, v, _, a). (v, a)) eff)"
apply(subst list.pred_set ListMem_iff)+
apply(drule wf_abs_eff)
by (metis (mono_tags, lifting) abs_rangeI case_prodI2 in_abs_rangeI)
lemma abs_valid_operator_4[intro!]:
"wf_operator op ⟹
list_all (λ(v, a). (∃y. abs_range_map v = Some y) ∧ ListMem a (the (abs_range_map v)))
(effect_of (abs_ast_operator op))"
using abs_valid_operator_4'
by (cases op, simp add: abs_ast_operator_def)
lemma consistent_list_set: "wf_partial_state s ⟹
list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') s) s"
by (auto simp add: list.pred_set wf_partial_state_def eq_key_imp_eq_value split: prod.splits)
lemma abs_valid_operator_5':
"wf_operator (name, pre, eff, cost) ⟹
list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') pre) pre"
apply(drule wf_operator_preD)
by (intro consistent_list_set)
lemma abs_valid_operator_5[intro!]:
"wf_operator op ⟹
list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') (precondition_of (abs_ast_operator op)))
(precondition_of (abs_ast_operator op))"
using abs_valid_operator_5'
by (cases op, simp add: abs_ast_operator_def)
lemma consistent_list_set_2: "distinct (map fst s) ⟹
list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') s) s"
by (auto simp add: list.pred_set wf_partial_state_def eq_key_imp_eq_value split: prod.splits)
lemma abs_valid_operator_6':
assumes "wf_operator (name, pre, eff, cost)"
shows "list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') (map (λ(_, v, _, a). (v, a)) eff))
(map (λ(_, v, _, a). (v, a)) eff)"
proof-
have *: "map fst (map (λ(_, v, _, a). (v, a)) eff) = (map (λ(_, v,_,_). v) eff)"
by (induction eff) auto
show ?thesis
using assms
apply(elim wf_operator_effE)
apply(intro consistent_list_set_2)
by (subst *)
qed
lemma abs_valid_operator_6[intro!]:
"wf_operator op ⟹
list_all (λ(v, a). list_all (λ(v', a'). v ≠ v' ∨ a = a') (effect_of (abs_ast_operator op)))
(effect_of (abs_ast_operator op))"
using abs_valid_operator_6'
by (cases op, simp add: abs_ast_operator_def)
end
context ast_problem
begin
definition abs_ast_operator_section
:: "nat_sas_plus_operator list"
where "abs_ast_operator_section ≡ [abs_ast_operator op. op ← astδ]"
definition abs_prob :: "nat_sas_plus_problem"
where "abs_prob = ⦇
variables_of = abs_ast_variable_section,
operators_of = abs_ast_operator_section,
initial_of = abs_ast_initial_state,
goal_of = abs_ast_goal,
range_of = abs_range_map
⦈"
end
context abs_ast_prob
begin
lemma [simp]: "op ∈ set astδ ⟹ (is_valid_operator_sas_plus abs_prob) (abs_ast_operator op)"
apply(cases op)
apply(subst is_valid_operator_sas_plus_def Let_def)+
using wf_operators(2)
by(fastforce simp add: abs_prob_def)+
lemma abs_ast_operator_section_valid:
"list_all (is_valid_operator_sas_plus abs_prob) abs_ast_operator_section"
by (auto simp: abs_ast_operator_section_def list.pred_set)
lemma abs_prob_valid: "is_valid_problem_sas_plus abs_prob"
using valid_abs_goal_1 valid_abs_goal_2 valid_abs_init_1 is_valid_vars_2
abs_ast_operator_section_valid[unfolded abs_prob_def]
by (auto simp add: is_valid_problem_sas_plus_def Let_def ListMem_iff abs_prob_def)
definition abs_ast_plan
:: " SASP_Semantics.plan ⇒ nat_sas_plus_plan"
where "abs_ast_plan πs
≡ map (abs_ast_operator o the o lookup_operator) πs"
lemma std_then_implici_effs[simp]: "is_standard_operator' (name, pres, effs, layer) ⟹ implicit_pres effs = []"
apply(induction effs)
by (auto simp add: is_standard_operator'_def implicit_pres_def is_standard_effect'_def)
lemma [simp]: "enabled π s ⟹ lookup_operator π = Some (name, pres, effs, layer) ⟹
is_standard_operator' (name, pres, effs, layer) ⟹
(filter (eff_enabled s) effs) = effs"
by(auto simp add: enabled_def is_standard_operator'_def eff_enabled_def is_standard_effect'_def filter_id_conv list.pred_set)
lemma effs_eq_abs_effs: "(effect_of (abs_ast_operator (name, pres, effs, layer))) =
(map (λ(_,x,_,v). (x,v)) effs)"
by (auto simp add: abs_ast_operator_def
split: option.splits prod.splits)
lemma exect_eq_abs_execute:
"⟦enabled π s; lookup_operator π = Some (name, preconds, effs, layer);
is_standard_operator'(name, preconds, effs, layer)⟧ ⟹
execute π s = (execute_operator_sas_plus s ((abs_ast_operator o the o lookup_operator) π))"
using effs_eq_abs_effs
by (auto simp add: execute_def execute_operator_sas_plus_def)
lemma enabled_then_sas_applicable:
"enabled π s ⟹ SAS_Plus_Representation.is_operator_applicable_in s ((abs_ast_operator o the o lookup_operator) π)"
by (auto simp add: subsuming_states_def enabled_def lookup_operator_def
SAS_Plus_Representation.is_operator_applicable_in_def abs_ast_operator_def
split: option.splits prod.splits)
lemma path_to_then_exec_serial: "∀π∈set πs. lookup_operator π ≠ None ⟹
path_to s πs s' ⟹
s' ⊆⇩m execute_serial_plan_sas_plus s (abs_ast_plan πs)"
proof(induction πs arbitrary: s s')
case (Cons a πs)
then show ?case
by (force simp: exect_eq_abs_execute abs_ast_plan_def lookup_Some_inδ no_cond_effs
dest: enabled_then_sas_applicable)
qed (auto simp: execute_serial_plan_sas_plus_def abs_ast_plan_def)
lemma map_of_eq_None_iff:
"(None = map_of xys x) = (x ∉ fst ` (set xys))"
by (induct xys) simp_all
lemma [simp]: "I = abs_ast_initial_state"
apply(intro HOL.ext)
by (auto simp: map_of_eq_None_iff set_map[symmetric] I_def abs_ast_initial_state_def map_of_zip_Some
dest: map_of_SomeD)
lemma [simp]: "∀π ∈ set πs. lookup_operator π ≠ None ⟹
op∈set (abs_ast_plan πs) ⟹ op ∈ set abs_ast_operator_section"
by (induction πs) (auto simp: abs_ast_plan_def abs_ast_operator_section_def lookup_Some_inδ)
end
context ast_problem
begin
lemma path_to_then_lookup_Some: "(∃s'∈G. path_to s πs s') ⟹ (∀π ∈ set πs. lookup_operator π ≠ None)"
by (induction πs arbitrary: s) (force simp add: enabled_def split: option.splits)+
lemma valid_plan_then_lookup_Some: "valid_plan πs ⟹ (∀π ∈ set πs. lookup_operator π ≠ None)"
using path_to_then_lookup_Some
by(simp add: valid_plan_def)
end
context abs_ast_prob
begin
theorem valid_plan_then_is_serial_sol:
assumes "valid_plan πs"
shows "is_serial_solution_for_problem abs_prob (abs_ast_plan πs)"
using valid_plan_then_lookup_Some[OF assms] assms
by (auto simp add: is_serial_solution_for_problem_def valid_plan_def initial_of_def
abs_prob_def abs_ast_goal_def G_def subsuming_states_def list_all_iff
ListMem_iff map_le_trans path_to_then_exec_serial
simp del: sas_plus_problem.select_defs)
end
subsection ‹Translating SAS+ represnetation to Fast-Downward's›
context ast_problem
begin
definition lookup_action:: "nat_sas_plus_operator ⇒ ast_operator option" where
"lookup_action op ≡
find (λ(_, pres, effs, _). precondition_of op = pres ∧
map (λ(v,a). ([], v, None, a)) (effect_of op) = effs)
astδ"
end
context abs_ast_prob
begin
lemma find_Some: "find P xs = Some x ⟹ x ∈ set xs ∧ P x"
by (auto simp add: find_Some_iff)
lemma distinct_find: "distinct (map f xs) ⟹ x ∈ set xs ⟹ find (λx'. f x' = f x) xs = Some x"
by (induction xs) (auto simp: image_def)
lemma lookup_operator_find: "lookup_operator nme = find (λop. fst op = nme) astδ"
by (auto simp: lookup_operator_def intro!: arg_cong[where f = "(λx. find x astδ)"])
lemma lookup_operator_works_1: "lookup_action op = Some π' ⟹ lookup_operator (fst π') = Some π'"
by (auto simp: wf_operators(1) lookup_operator_find lookup_action_def dest: find_Some intro: distinct_find)
lemma lookup_operator_works_2:
"lookup_action (abs_ast_operator (name, pres, effs, layer)) = Some (name', pres', effs', layer')
⟹ pres = pres'"
by (auto simp: lookup_action_def abs_ast_operator_def dest!: find_Some)
lemma [simp]: "is_standard_operator' (name, pres, effs, layer) ⟹
map (λ(v,a). ([], v, None, a)) (effect_of (abs_ast_operator (name, pres, effs, layer))) = effs"
by (induction effs) (auto simp: is_standard_operator'_def abs_ast_operator_def is_standard_effect'_def)
lemma lookup_operator_works_3:
"is_standard_operator' (name, pres, effs, layer) ⟹ (name, pres, effs, layer) ∈ set astδ ⟹
lookup_action (abs_ast_operator (name, pres, effs, layer)) = Some (name', pres', effs', layer')
⟹ effs = effs'"
by(auto simp: is_standard_operator'_def lookup_action_def dest!: find_Some)
lemma mem_find_Some: "x ∈ set xs ⟹ P x ⟹ ∃x'. find P xs = Some x'"
by (induction xs) auto
lemma [simp]: "precondition_of (abs_ast_operator (x1, a, aa, b)) = a"
by(simp add: abs_ast_operator_def)
lemma std_lookup_action: "is_standard_operator' ast_op ⟹ ast_op ∈ set astδ ⟹
∃ast_op'. lookup_action (abs_ast_operator ast_op) = Some ast_op'"
unfolding lookup_action_def
apply(intro mem_find_Some)
by (auto split: prod.splits simp: o_def)
lemma is_applicable_then_enabled_1:
"ast_op ∈ set astδ ⟹
∃ast_op'. lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some ast_op'"
using lookup_operator_works_1 std_lookup_action no_cond_effs
by auto
lemma lookup_action_Some_in_δ: "lookup_action op = Some ast_op ⟹ ast_op ∈ set astδ"
using lookup_operator_works_1 lookup_Some_inδ by fastforce
lemma lookup_operator_eq_name: "lookup_operator name = Some (name', pres, effs, layer) ⟹ name = name'"
using lookup_operator_wf(2)
by fastforce
lemma eq_name_eq_pres: "(name, pres, effs, layer) ∈ set astδ ⟹ (name, pres', effs', layer') ∈ set astδ
⟹ pres = pres'"
using eq_key_imp_eq_value[OF wf_operators(1)]
by auto
lemma eq_name_eq_effs:
"name = name' ⟹ (name, pres, effs, layer) ∈ set astδ ⟹ (name', pres', effs', layer') ∈ set astδ
⟹ effs = effs'"
using eq_key_imp_eq_value[OF wf_operators(1)]
by auto
lemma is_applicable_then_subsumes:
"s ∈ valid_states ⟹
SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator (name, pres, effs, layer)) ⟹
s ∈ subsuming_states (map_of pres)"
by (simp add: subsuming_states_def SAS_Plus_Representation.is_operator_applicable_in_def
abs_ast_operator_def)
lemma eq_name_eq_pres':
"⟦s ∈ valid_states ; is_standard_operator' (name, pres, effs, layer); (name, pres, effs, layer) ∈ set astδ ;
lookup_operator ((fst o the o lookup_action o abs_ast_operator) (name, pres, effs, layer)) = Some (name', pres', effs', layer')⟧
⟹ pres = pres'"
using lookup_operator_eq_name lookup_operator_works_2
by (fastforce dest!: std_lookup_action
simp: eq_name_eq_pres[OF lookup_action_Some_in_δ lookup_Some_inδ])
lemma is_applicable_then_enabled_2:
"⟦s ∈ valid_states ; ast_op ∈ set astδ ;
SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op);
lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some (name, pres, effs, layer)⟧
⟹ s∈subsuming_states (map_of pres)"
apply(cases ast_op)
using eq_name_eq_pres' is_applicable_then_subsumes no_cond_effs
by fastforce
lemma is_applicable_then_enabled_3:
"⟦s ∈ valid_states;
lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some (name, pres, effs, layer)⟧
⟹ s∈subsuming_states (map_of (implicit_pres effs))"
apply(cases ast_op)
using no_cond_effs
by (auto dest!: std_then_implici_effs std_lookup_action lookup_Some_inδ
simp: subsuming_states_def)
lemma is_applicable_then_enabled:
"⟦s ∈ valid_states; ast_op ∈ set astδ;
SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op)⟧
⟹ enabled ((fst o the o lookup_action o abs_ast_operator) ast_op) s"
using is_applicable_then_enabled_1 is_applicable_then_enabled_2 is_applicable_then_enabled_3
by(simp add: enabled_def split: option.splits)
lemma eq_name_eq_effs':
assumes "lookup_operator ((fst o the o lookup_action o abs_ast_operator) (name, pres, effs, layer)) =
Some (name', pres', effs', layer')"
"is_standard_operator' (name, pres, effs, layer)" "(name, pres, effs, layer) ∈ set astδ"
"s ∈ valid_states"
shows "effs = effs'"
using std_lookup_action[OF assms(2,3)] assms
by (auto simp: lookup_operator_works_3[OF assms(2,3)]
eq_name_eq_effs[OF lookup_operator_eq_name lookup_action_Some_in_δ lookup_Some_inδ])
lemma std_eff_enabled'[simp]:
"is_standard_operator' (name, pres, effs, layer) ⟹ s ∈ valid_states ⟹ (filter (eff_enabled s) effs) = effs"
by (induction effs) (auto simp: is_standard_operator'_def is_standard_effect'_def eff_enabled_def subsuming_states_def)
lemma execute_abs:
"⟦s ∈ valid_states; ast_op ∈ set astδ;
SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op)⟧ ⟹
execute ((fst o the o lookup_action o abs_ast_operator) ast_op) s =
execute_operator_sas_plus s (abs_ast_operator ast_op)"
using no_cond_effs
by(cases ast_op)
(fastforce simp add: execute_def execute_operator_sas_plus_def effs_eq_abs_effs
dest: is_applicable_then_enabled_1 eq_name_eq_effs'[unfolded o_def]
split: option.splits)+
fun sat_preconds_as where
"sat_preconds_as s [] = True"
| "sat_preconds_as s (op#ops) =
(SAS_Plus_Representation.is_operator_applicable_in s op ∧
sat_preconds_as (execute_operator_sas_plus s op) ops)"
lemma exec_serial_then_path_to':
"⟦s ∈ valid_states;
∀op∈set ops. ∃ast_op∈ set astδ. op = abs_ast_operator ast_op;
(sat_preconds_as s ops)⟧ ⟹
path_to s (map (fst o the o lookup_action) ops) (execute_serial_plan_sas_plus s ops)"
proof(induction ops arbitrary: s)
case (Cons a ops)
then show ?case
using execute_abs is_applicable_then_enabled execute_preserves_valid
apply simp
by metis
qed auto
end
fun rem_condless_ops where
"rem_condless_ops s [] = []"
| "rem_condless_ops s (op#ops) =
(if SAS_Plus_Representation.is_operator_applicable_in s op then
op # (rem_condless_ops (execute_operator_sas_plus s op) ops)
else [])"
context abs_ast_prob
begin
lemma exec_rem_consdless: "execute_serial_plan_sas_plus s (rem_condless_ops s ops) = execute_serial_plan_sas_plus s ops"
by (induction ops arbitrary: s) auto
lemma rem_conless_sat: "sat_preconds_as s (rem_condless_ops s ops)"
by (induction ops arbitrary: s) auto
lemma set_rem_condlessD: "x ∈ set (rem_condless_ops s ops) ⟹ x ∈ set ops"
by (induction ops arbitrary: s) auto
lemma exec_serial_then_path_to:
"⟦s ∈ valid_states;
∀op∈set ops. ∃ast_op∈ set astδ. op = abs_ast_operator ast_op⟧ ⟹
path_to s (((map (fst o the o lookup_action)) o rem_condless_ops s) ops)
(execute_serial_plan_sas_plus s ops)"
using rem_conless_sat
by (fastforce dest!: set_rem_condlessD
intro!: exec_serial_then_path_to'
[where s = s and ops = "rem_condless_ops s ops",
unfolded exec_rem_consdless])
lemma is_serial_solution_then_abstracted:
"is_serial_solution_for_problem abs_prob ops
⟹ ∀op∈set ops. ∃ast_op∈ set astδ. op = abs_ast_operator ast_op"
by(auto simp: is_serial_solution_for_problem_def abs_prob_def Let_def list.pred_set
ListMem_iff abs_ast_operator_section_def
split: if_splits)
lemma lookup_operator_works_1': "lookup_action op = Some π' ⟹ ∃op. lookup_operator (fst π') = op"
using lookup_operator_works_1 by auto
lemma is_serial_sol_then_valid_plan_1:
"⟦is_serial_solution_for_problem abs_prob ops;
π ∈ set ((map (fst o the o lookup_action) o rem_condless_ops I) ops)⟧ ⟹
lookup_operator π ≠ None"
using std_lookup_action lookup_operator_works_1 no_cond_effs
by (fastforce dest!: set_rem_condlessD is_serial_solution_then_abstracted
simp: valid_plan_def list.pred_set ListMem_iff)
lemma is_serial_sol_then_valid_plan_2:
"⟦is_serial_solution_for_problem abs_prob ops⟧ ⟹
(∃s'∈G. path_to I ((map (fst o the o lookup_action) o rem_condless_ops I) ops) s')"
using I_valid
by (fastforce intro: path_to_pres_valid exec_serial_then_path_to
intro!: bexI[where x = "execute_serial_plan_sas_plus I ops"]
dest: is_serial_solution_then_abstracted
simp: list.pred_set ListMem_iff abs_ast_operator_section_def
G_def subsuming_states_def is_serial_solution_for_problem_def
abs_prob_def abs_ast_goal_def)+
end
context ast_problem
begin
definition "decode_abs_plan ≡ (map (fst o the o lookup_action) o rem_condless_ops I)"
end
context abs_ast_prob
begin
theorem is_serial_sol_then_valid_plan:
"⟦is_serial_solution_for_problem abs_prob ops⟧ ⟹
valid_plan (decode_abs_plan ops)"
using is_serial_sol_then_valid_plan_1 is_serial_sol_then_valid_plan_2
by(simp add: valid_plan_def decode_abs_plan_def)
end
end
Theory Set2_Join_RBT
section "Join-Based Implementation of Sets via RBTs"
theory Set2_Join_RBT
imports
"HOL-Data_Structures.Set2_Join"
"HOL-Data_Structures.RBT_Set"
begin
subsection "Code"
text ‹
Function ‹joinL› joins two trees (and an element).
Precondition: \<^prop>‹bheight l ≤ bheight r›.
Method:
Descend along the left spine of ‹r›
until you find a subtree with the same ‹bheight› as ‹l›,
then combine them into a new red node.
›
fun joinL :: "'a rbt ⇒ 'a ⇒ 'a rbt ⇒ 'a rbt" where
"joinL l x r =
(if bheight l ≥ bheight r then R l x r
else case r of
B l' x' r' ⇒ baliL (joinL l x l') x' r' |
R l' x' r' ⇒ R (joinL l x l') x' r')"
fun joinR :: "'a rbt ⇒ 'a ⇒ 'a rbt ⇒ 'a rbt" where
"joinR l x r =
(if bheight l ≤ bheight r then R l x r
else case l of
B l' x' r' ⇒ baliR l' x' (joinR r' x r) |
R l' x' r' ⇒ R l' x' (joinR r' x r))"
definition join :: "'a rbt ⇒ 'a ⇒ 'a rbt ⇒ 'a rbt" where
"join l x r =
(if bheight l > bheight r
then paint Black (joinR l x r)
else if bheight l < bheight r
then paint Black (joinL l x r)
else B l x r)"
declare joinL.simps[simp del]
declare joinR.simps[simp del]
subsection "Properties"
subsubsection "Color and height invariants"
lemma invc2_joinL:
"⟦ invc l; invc r; bheight l ≤ bheight r ⟧ ⟹
invc2 (joinL l x r)
∧ (bheight l ≠ bheight r ∧ color r = Black ⟶ invc(joinL l x r))"
proof (induct l x r rule: joinL.induct)
case (1 l x r) thus ?case
by(auto simp: invc_baliL invc2I joinL.simps[of l x r] split!: tree.splits if_splits)
qed
lemma invc2_joinR:
"⟦ invc l; invh l; invc r; invh r; bheight l ≥ bheight r ⟧ ⟹
invc2 (joinR l x r)
∧ (bheight l ≠ bheight r ∧ color l = Black ⟶ invc(joinR l x r))"
proof (induct l x r rule: joinR.induct)
case (1 l x r) thus ?case
by(fastforce simp: invc_baliR invc2I joinR.simps[of l x r] split!: tree.splits if_splits)
qed
lemma bheight_joinL:
"⟦ invh l; invh r; bheight l ≤ bheight r ⟧ ⟹ bheight (joinL l x r) = bheight r"
proof (induct l x r rule: joinL.induct)
case (1 l x r) thus ?case
by(auto simp: bheight_baliL joinL.simps[of l x r] split!: tree.split)
qed
lemma invh_joinL:
"⟦ invh l; invh r; bheight l ≤ bheight r ⟧ ⟹ invh (joinL l x r)"
proof (induct l x r rule: joinL.induct)
case (1 l x r) thus ?case
by(auto simp: invh_baliL bheight_joinL joinL.simps[of l x r] split!: tree.split color.split)
qed
lemma bheight_baliR:
"bheight l = bheight r ⟹ bheight (baliR l a r) = Suc (bheight l)"
by (cases "(l,a,r)" rule: baliR.cases) auto
lemma bheight_joinR:
"⟦ invh l; invh r; bheight l ≥ bheight r ⟧ ⟹ bheight (joinR l x r) = bheight l"
proof (induct l x r rule: joinR.induct)
case (1 l x r) thus ?case
by(fastforce simp: bheight_baliR joinR.simps[of l x r] split!: tree.split)
qed
lemma invh_joinR:
"⟦ invh l; invh r; bheight l ≥ bheight r ⟧ ⟹ invh (joinR l x r)"
proof (induct l x r rule: joinR.induct)
case (1 l x r) thus ?case
by(fastforce simp: invh_baliR bheight_joinR joinR.simps[of l x r]
split!: tree.split color.split)
qed
lemma rbt_join: "⟦ invc l; invh l; invc r; invh r ⟧ ⟹ rbt(join l x r)"
by(simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint rbt_def
color_paint_Black join_def)
text ‹To make sure the the black height is not increased unnecessarily:›
lemma bheight_paint_Black: "bheight(paint Black t) ≤ bheight t + 1"
by(cases t) auto
lemma "⟦ rbt l; rbt r ⟧ ⟹ bheight(join l x r) ≤ max (bheight l) (bheight r) + 1"
using bheight_paint_Black[of "joinL l x r"] bheight_paint_Black[of "joinR l x r"]
bheight_joinL[of l r x] bheight_joinR[of l r x]
by(auto simp: max_def rbt_def join_def)
subsubsection "Inorder properties"
text "Currently unused. Instead \<^const>‹set_tree› and \<^const>‹bst› properties are proved directly."
lemma inorder_joinL: "bheight l ≤ bheight r ⟹ inorder(joinL l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinL.induct)
case (1 l x r)
thus ?case by(auto simp: inorder_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed
lemma inorder_joinR:
"inorder(joinR l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinR.induct)
case (1 l x r)
thus ?case by (force simp: inorder_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed
lemma "inorder(join l x r) = inorder l @ x # inorder r"
by(auto simp: inorder_joinL inorder_joinR inorder_paint join_def
split!: tree.splits color.splits if_splits
dest!: arg_cong[where f = inorder])
subsubsection "Set and bst properties"
lemma set_baliL:
"set_tree(baliL l a r) = set_tree l ∪ {a} ∪ set_tree r"
by(cases "(l,a,r)" rule: baliL.cases) (auto)
lemma set_joinL:
"bheight l ≤ bheight r ⟹ set_tree (joinL l x r) = set_tree l ∪ {x} ∪ set_tree r"
proof(induction l x r rule: joinL.induct)
case (1 l x r)
thus ?case by(auto simp: set_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed
lemma set_baliR:
"set_tree(baliR l a r) = set_tree l ∪ {a} ∪ set_tree r"
by(cases "(l,a,r)" rule: baliR.cases) (auto)
lemma set_joinR:
"set_tree (joinR l x r) = set_tree l ∪ {x} ∪ set_tree r"
proof(induction l x r rule: joinR.induct)
case (1 l x r)
thus ?case by(force simp: set_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed
lemma set_paint: "set_tree (paint c t) = set_tree t"
by (cases t) auto
lemma set_join: "set_tree (join l x r) = set_tree l ∪ {x} ∪ set_tree r"
by(simp add: set_joinL set_joinR set_paint join_def)
lemma bst_baliL:
"⟦bst l; bst r; ∀x∈set_tree l. x < a; ∀x∈set_tree r. a < x⟧
⟹ bst (baliL l a r)"
by(cases "(l,a,r)" rule: baliL.cases) (auto simp: ball_Un)
lemma bst_baliR:
"⟦bst l; bst r; ∀x∈set_tree l. x < a; ∀x∈set_tree r. a < x⟧
⟹ bst (baliR l a r)"
by(cases "(l,a,r)" rule: baliR.cases) (auto simp: ball_Un)
lemma bst_joinL:
"⟦bst (Node l (a, n) r); bheight l ≤ bheight r⟧
⟹ bst (joinL l a r)"
proof(induction l a r rule: joinL.induct)
case (1 l a r)
thus ?case
by(auto simp: set_baliL joinL.simps[of l a r] set_joinL ball_Un intro!: bst_baliL
split!: tree.splits color.splits)
qed
lemma bst_joinR:
"⟦bst l; bst r; ∀x∈set_tree l. x < a; ∀y∈set_tree r. a < y ⟧
⟹ bst (joinR l a r)"
proof(induction l a r rule: joinR.induct)
case (1 l a r)
thus ?case
by(auto simp: set_baliR joinR.simps[of l a r] set_joinR ball_Un intro!: bst_baliR
split!: tree.splits color.splits)
qed
lemma bst_paint: "bst (paint c t) = bst t"
by(cases t) auto
lemma bst_join:
"bst (Node l (a, n) r) ⟹ bst (join l a r)"
by(auto simp: bst_paint bst_joinL bst_joinR join_def)
lemma inv_join: "⟦ invc l; invh l; invc r; invh r ⟧ ⟹ invc(join l x r) ∧ invh(join l x r)"
by (simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint join_def)
subsubsection "Interpretation of \<^locale>‹Set2_Join› with Red-Black Tree"
global_interpretation RBT: Set2_Join
where join = join and inv = "λt. invc t ∧ invh t"
defines insert_rbt = RBT.insert and delete_rbt = RBT.delete and split_rbt = RBT.split
and join2_rbt = RBT.join2 and split_min_rbt = RBT.split_min and inter_rbt = RBT.inter
proof (standard, goal_cases)
case 1 show ?case by (rule set_join)
next
case 2 thus ?case by (simp add: bst_join)
next
case 3 show ?case by simp
next
case 4 thus ?case by (simp add: inv_join)
next
case 5 thus ?case by simp
qed
text ‹The invariant does not guarantee that the root node is black. This is not required
to guarantee that the height is logarithmic in the size --- Exercise.›
end
Theory Solve_SASP
theory Solve_SASP
imports AST_SAS_Plus_Equivalence "SAT_Solve_SAS_Plus"
"HOL-Data_Structures.RBT_Map" "HOL-Library.Code_Target_Nat" HOL.String
AI_Planning_Languages_Semantics.SASP_Checker Set2_Join_RBT
begin
subsection ‹SAT encoding works for Fast-Downward's representation›
context abs_ast_prob
begin
theorem is_serial_sol_then_valid_plan_encoded:
"𝒜 ⊨ Φ⇩∀ (φ (prob_with_noop abs_prob)) t ⟹
valid_plan
(decode_abs_plan
(rem_noops
(map (λop. φ⇩O¯ (prob_with_noop abs_prob) op)
(concat (Φ¯ (φ (prob_with_noop abs_prob)) 𝒜 t)))))"
by (fastforce intro!: is_serial_sol_then_valid_plan abs_prob_valid
sas_plus_problem_has_serial_solution_iff_i')
lemma length_abs_ast_plan: "length πs = length (abs_ast_plan πs)"
by (auto simp: abs_ast_plan_def)
theorem valid_plan_then_is_serial_sol_encoded:
"valid_plan πs ⟹ length πs ≤ h ⟹ ∃𝒜. 𝒜 ⊨ Φ⇩∀ (φ (prob_with_noop abs_prob)) h"
apply(subst (asm) length_abs_ast_plan)
by (fastforce intro!: sas_plus_problem_has_serial_solution_iff_ii' abs_prob_valid
valid_plan_then_is_serial_sol)
end
section ‹DIMACS-like semantics for CNF formulae›
text ‹We now push the SAT encoding towards a lower-level representation by replacing the atoms which
have variable IDs and time steps into natural numbers.›
lemma gtD: "((l::nat) < n) ⟹ (∃m. n = Suc m ∧ l ≤ m)"
by (induction n) auto
locale cnf_to_dimacs =
fixes h :: nat and n_ops :: nat
begin
fun var_to_dimacs where
"var_to_dimacs (Operator t k) = 1 + t + k * h"
| "var_to_dimacs (State t k) = 1 + n_ops * h + t + k * (h)"
definition dimacs_to_var where
"dimacs_to_var v ≡
if v < 1 + n_ops * h then
Operator ((v - 1) mod (h)) ((v - 1) div (h))
else
(let k = ((v - 1) - n_ops * h) in
State (k mod (h)) (k div (h)))"
fun valid_state_var where
"valid_state_var (Operator t k) ⟷ t < h ∧ k < n_ops"
| "valid_state_var (State t k) ⟷ t < h"
lemma State_works:
"valid_state_var (State t k) ⟹
dimacs_to_var (var_to_dimacs (State t k)) =
(State t k)"
by (induction k) (auto simp add: dimacs_to_var_def add.left_commute Let_def)
lemma Operator_works:
"valid_state_var (Operator t k) ⟹
dimacs_to_var (var_to_dimacs (Operator t k)) =
(Operator t k)"
by (induction k) (auto simp add: algebra_simps dimacs_to_var_def gr0_conv_Suc nat_le_iff_add dest!: gtD)
lemma sat_plan_to_dimacs_works:
"valid_state_var sv ⟹
dimacs_to_var (var_to_dimacs sv) = sv"
apply(cases sv)
using State_works Operator_works
by auto
end
lemma changing_atoms_works:
"(⋀x. P x ⟹ (f o g) x = x) ⟹ (∀x∈atoms phi. P x) ⟹ M ⊨ phi ⟷ M o f ⊨ map_formula g phi"
by (induction phi) auto
lemma changing_atoms_works':
"M o g ⊨ phi ⟷ M ⊨ map_formula g phi"
by (induction phi) auto
context cnf_to_dimacs
begin
lemma sat_plan_to_dimacs:
"(⋀sv. sv∈atoms sat_plan_formula ⟹ valid_state_var sv) ⟹
M ⊨ sat_plan_formula
⟷ M o dimacs_to_var ⊨ map_formula var_to_dimacs sat_plan_formula"
by(auto intro!: changing_atoms_works[where P = valid_state_var] simp: sat_plan_to_dimacs_works)
lemma dimacs_to_sat_plan:
"M o var_to_dimacs ⊨ sat_plan_formula
⟷ M ⊨ map_formula var_to_dimacs sat_plan_formula"
using changing_atoms_works' .
end
locale sat_solve_sasp = abs_ast_prob "Π" + cnf_to_dimacs "Suc h" "Suc (length astδ)"
for Π h
begin
lemma encode_initial_state_valid:
"sv ∈ atoms (encode_initial_state Prob) ⟹ valid_state_var sv"
by (auto simp add: encode_state_variable_def Let_def encode_initial_state_def split: sat_plan_variable.splits bool.splits)
lemma length_operators: "length (operators_of (φ (prob_with_noop abs_prob))) = Suc (length astδ)"
by(simp add: abs_prob_def abs_ast_operator_section_def sas_plus_problem_to_strips_problem_def prob_with_noop_def)
lemma encode_operator_effect_valid_1: "t < h ⟹ op ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
sv ∈ atoms
(❙⋀(map (λv.
❙¬(Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
❙∨ Atom (State (Suc t) (index vs v)))
asses)) ⟹
valid_state_var sv"
using length_operators
by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)
lemma encode_operator_effect_valid_2: "t < h ⟹ op ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
sv ∈ atoms
(❙⋀(map (λv.
❙¬(Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
❙∨ ❙¬ (Atom (State (Suc t) (index vs v))))
asses)) ⟹
valid_state_var sv"
using length_operators
by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)
end
lemma atoms_And_append: "atoms (❙⋀ (as1 @ as2)) = atoms (❙⋀ as1) ∪ atoms (❙⋀ as2)"
by (induction as1) auto
context sat_solve_sasp
begin
lemma encode_operator_effect_valid:
"sv ∈ atoms (encode_operator_effect (φ (prob_with_noop abs_prob)) t op) ⟹
t < h ⟹ op ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
valid_state_var sv"
by (force simp: encode_operator_effect_def Let_def atoms_And_append
intro!: encode_operator_effect_valid_1 encode_operator_effect_valid_2)
end
lemma foldr_And: "foldr (❙∧) as (❙¬ ⊥) = (❙⋀ as)"
by (induction as) auto
context sat_solve_sasp
begin
lemma encode_all_operator_effects_valid:
"t < Suc h ⟹
sv ∈ atoms (encode_all_operator_effects (φ (prob_with_noop abs_prob)) (operators_of (φ (prob_with_noop abs_prob))) t) ⟹
valid_state_var sv"
unfolding encode_all_operator_effects_def foldr_And
by (force simp add: encode_operator_effect_valid)
lemma encode_operator_precondition_valid_1:
"t < h ⟹ op ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
sv ∈ atoms
(❙⋀(map (λv.
❙¬ (Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op))) ❙∨ Atom (State t (f v)))
asses)) ⟹
valid_state_var sv"
using length_operators
by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)
lemma encode_operator_precondition_valid:
"sv ∈ atoms (encode_operator_precondition (φ (prob_with_noop abs_prob)) t op) ⟹
t < h ⟹ op ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
valid_state_var sv"
by (force simp: encode_operator_precondition_def Let_def
intro!: encode_operator_precondition_valid_1)
lemma encode_all_operator_preconditions_valid:
"t < Suc h ⟹
sv ∈ atoms (encode_all_operator_preconditions (φ (prob_with_noop abs_prob)) (operators_of (φ (prob_with_noop abs_prob))) t) ⟹
valid_state_var sv"
unfolding encode_all_operator_preconditions_def foldr_And
by (force simp add: encode_operator_precondition_valid)
lemma encode_operators_valid:
"sv ∈ atoms (encode_operators (φ (prob_with_noop abs_prob)) t) ⟹ t < Suc h ⟹
valid_state_var sv"
unfolding encode_operators_def Let_def
by (force simp add: encode_all_operator_preconditions_valid encode_all_operator_effects_valid)
lemma encode_negative_transition_frame_axiom':
"t < h ⟹
set deleting_operators ⊆ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
sv ∈ atoms
(❙¬(Atom (State t v_idx))
❙∨ (Atom (State (Suc t) v_idx)
❙∨ ❙⋁ (map (λop. Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
deleting_operators))) ⟹
valid_state_var sv"
by (induction deleting_operators) (auto simp: length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)
lemma encode_negative_transition_frame_axiom_valid:
"sv ∈ atoms (encode_negative_transition_frame_axiom (φ (prob_with_noop abs_prob)) t v) ⟹ t < h ⟹
valid_state_var sv"
unfolding encode_negative_transition_frame_axiom_def Let_def
apply(intro encode_negative_transition_frame_axiom'[of t])
by auto
lemma encode_positive_transition_frame_axiom_valid:
"sv ∈ atoms (encode_positive_transition_frame_axiom (φ (prob_with_noop abs_prob)) t v) ⟹ t < h ⟹
valid_state_var sv"
unfolding encode_positive_transition_frame_axiom_def Let_def
apply(intro encode_negative_transition_frame_axiom'[of t])
by auto
lemma encode_all_frame_axioms_valid:
"sv ∈ atoms (encode_all_frame_axioms (φ (prob_with_noop abs_prob)) t) ⟹ t < Suc h ⟹
valid_state_var sv"
unfolding encode_all_frame_axioms_def Let_def atoms_And_append
by (force simp add: encode_negative_transition_frame_axiom_valid encode_positive_transition_frame_axiom_valid)
lemma encode_goal_state_valid:
"sv ∈ atoms (encode_goal_state Prob t) ⟹ t < Suc h ⟹ valid_state_var sv"
by (auto simp add: encode_state_variable_def Let_def encode_goal_state_def split: sat_plan_variable.splits bool.splits)
lemma encode_problem_valid:
"sv ∈ atoms (encode_problem (φ (prob_with_noop abs_prob)) h) ⟹ valid_state_var sv"
unfolding encode_problem_def
using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
by fastforce
lemma encode_interfering_operator_pair_exclusion_valid:
"sv ∈ atoms (encode_interfering_operator_pair_exclusion (φ (prob_with_noop abs_prob)) t op⇩1 op⇩2) ⟹ t < Suc h ⟹
op⇩1 ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹ op⇩2 ∈ set (operators_of (φ (prob_with_noop abs_prob))) ⟹
valid_state_var sv"
by (auto simp: encode_interfering_operator_pair_exclusion_def Let_def length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)
lemma encode_interfering_operator_exclusion_valid:
"sv ∈ atoms (encode_interfering_operator_exclusion (φ (prob_with_noop abs_prob)) t) ⟹ t < Suc h ⟹
valid_state_var sv"
unfolding encode_interfering_operator_exclusion_def Let_def foldr_And
by (force simp add: encode_interfering_operator_pair_exclusion_valid)
lemma encode_problem_with_operator_interference_exclusion_valid:
"sv ∈ atoms (encode_problem_with_operator_interference_exclusion (φ (prob_with_noop abs_prob)) h) ⟹ valid_state_var sv"
unfolding encode_problem_with_operator_interference_exclusion_def
using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
encode_interfering_operator_exclusion_valid
by fastforce
lemma planning_by_cnf_dimacs_complete:
"valid_plan πs ⟹ length πs ≤ h ⟹
∃M. M ⊨ map_formula var_to_dimacs (Φ⇩∀ (φ (prob_with_noop abs_prob)) h)"
using valid_plan_then_is_serial_sol_encoded
sat_plan_to_dimacs[OF encode_problem_with_operator_interference_exclusion_valid]
by meson
lemma planning_by_cnf_dimacs_sound:
"𝒜 ⊨ map_formula var_to_dimacs (Φ⇩∀ (φ (prob_with_noop abs_prob)) t) ⟹
valid_plan
(decode_abs_plan
(rem_noops
(map (λop. φ⇩O¯ (prob_with_noop abs_prob) op)
(concat (Φ¯ (φ (prob_with_noop abs_prob)) (𝒜 o var_to_dimacs) t)))))"
using changing_atoms_works'
by (fastforce intro!: is_serial_sol_then_valid_plan_encoded)
end
subsection ‹Going from Formualae to DIMACS-like CNF›
text ‹We now represent the CNF formulae into a very low-level representation that is reminiscent to
the DIMACS representation, where a CNF formula is a list of list of integers.›
fun disj_to_dimacs::"nat formula ⇒ int list" where
"disj_to_dimacs (φ⇩1 ❙∨ φ⇩2) = disj_to_dimacs φ⇩1 @ disj_to_dimacs φ⇩2"
| "disj_to_dimacs ⊥ = []"
| "disj_to_dimacs (Not ⊥) = [-1::int,1::int]"
| "disj_to_dimacs (Atom v) = [int v]"
| "disj_to_dimacs (Not (Atom v)) = [-(int v)]"
fun cnf_to_dimacs::"nat formula ⇒ int list list" where
"cnf_to_dimacs (φ⇩1 ❙∧ φ⇩2) = cnf_to_dimacs φ⇩1 @ cnf_to_dimacs φ⇩2"
| "cnf_to_dimacs d = [disj_to_dimacs d]"
definition "dimacs_lit_to_var l ≡ nat (abs l)"
definition "find_max (xs::nat list)≡ (fold max xs 1)"
lemma find_max_works:
"x ∈ set xs ⟹ x ≤ find_max xs" (is "?P ⟹ ?Q")
proof-
have "x ∈ set xs ⟹ (x::nat) ≤ (fold max xs m)" for m
unfolding max_def
apply (induction xs arbitrary: m rule: rev_induct)
using nat_le_linear
by (auto dest: le_trans simp add:)
thus "?P ⟹ ?Q"
by(auto simp add: find_max_def max_def)
qed
fun formula_vars where
"formula_vars (⊥) = []" |
"formula_vars (Atom k) = [k]" |
"formula_vars (Not F) = formula_vars F" |
"formula_vars (And F G) = formula_vars F @ formula_vars G" |
"formula_vars (Imp F G) = formula_vars F @ formula_vars G" |
"formula_vars (Or F G) = formula_vars F @ formula_vars G"
lemma atoms_formula_vars: "atoms f = set (formula_vars f)"
by (induction f) auto
lemma max_var: "v ∈ atoms (f::nat formula) ⟹ v ≤ find_max (formula_vars f)"
using find_max_works
by(simp add: atoms_formula_vars)
definition "dimacs_max_var cs ≡ find_max (map (find_max o (map (nat o abs))) cs)"
lemma fold_max_ge: "b ≤ a ⟹ (b::nat) ≤ fold (λx m. if m ≤ x then x else m) ys a"
by (induction ys arbitrary: a b) auto
lemma find_max_append: "find_max (xs @ ys) = max (find_max xs) (find_max ys) "
apply(simp only: Max.set_eq_fold[symmetric] append_Cons[symmetric] set_append find_max_def)
by (metis List.finite_set Max.union Un_absorb Un_insert_left Un_insert_right list.distinct(1) list.simps(15) set_empty)
definition dimacs_model::"int list ⇒ int list list ⇒ bool" where
"dimacs_model ls cs ≡ (∀c∈set cs. (∃l∈set ls. l ∈ set c)) ∧
distinct (map dimacs_lit_to_var ls)"
fun model_to_dimacs_model where
"model_to_dimacs_model M (v#vs) = (if M v then int v else - (int v)) # (model_to_dimacs_model M vs)"
| "model_to_dimacs_model _ [] = []"
lemma model_to_dimacs_model_append:
"set (model_to_dimacs_model M (vs @ vs')) = set (model_to_dimacs_model M vs) ∪ set (model_to_dimacs_model M vs')"
by (induction vs) auto
lemma upt_append_sing: "xs @ [x] = [a..<n_vars] ⟹ a < n_vars ⟹ (xs = [a..<n_vars - 1] ∧ x = n_vars-1 ∧ n_vars > 0)"
by (induction "n_vars") auto
lemma upt_eqD: "upt a b = upt a b' ⟹ (b = b' ∨ b' ≤ a ∨ b ≤ a)"
by (induction b) (auto dest!: upt_append_sing split: if_splits)
lemma pos_in_model: "M n ⟹ 0 < n ⟹ n < n_vars ⟹ int n ∈ set (model_to_dimacs_model M [1..<n_vars])"
by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append )
lemma neg_in_model: "¬ M n ⟹ 0 < n ⟹ n < n_vars ⟹ - (int n) ∈ set (model_to_dimacs_model M [1..<n_vars])"
by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)
lemma in_model: "0 < n ⟹ n < n_vars ⟹ int n ∈ set (model_to_dimacs_model M [1..<n_vars]) ∨ - (int n) ∈ set (model_to_dimacs_model M [1..<n_vars])"
using pos_in_model neg_in_model
by metis
lemma model_to_dimacs_model_all_vars:
"(∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_cnf f ⟹ M ⊨ f ⟹
(∀n<n_vars. 0 < n ⟶ (int n ∈ set (model_to_dimacs_model M [(1::nat)..<n_vars]) ∨
-(int n) ∈ set (model_to_dimacs_model M [(1::nat)..<n_vars])))"
using in_model neg_in_model pos_in_model
by (auto simp add: le_less model_to_dimacs_model_append split: if_splits)
lemma cnf_And: "set (cnf_to_dimacs (f1 ❙∧ f2)) = set (cnf_to_dimacs f1) ∪ set (cnf_to_dimacs f2)"
by auto
lemma one_always_in:
"1 < n_vars ⟹ 1 ∈ set (model_to_dimacs_model M ([1..<n_vars])) ∨ - 1 ∈ set (model_to_dimacs_model M ([1..<n_vars]))"
by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)
lemma [simp]: "(disj_to_dimacs (f1 ❙∨ f2)) = (disj_to_dimacs f1) @ (disj_to_dimacs f2)"
by auto
lemma [simp]: "(atoms (f1 ❙∨ f2)) = atoms f1 ∪ atoms f2"
by auto
lemma isdisj_disjD: "(is_disj (f1 ❙∨ f2)) ⟹ is_disj f1 ∧ is_disj f2"
by (cases f1; auto)
lemma disj_to_dimacs_sound:
"1 < n_vars ⟹ (∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_disj f ⟹ M ⊨ f
⟹ ∃l∈set (model_to_dimacs_model M [(1::nat)..<n_vars]). l ∈ set (disj_to_dimacs f)"
apply(induction f)
using neg_in_model pos_in_model one_always_in
by (fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD)+
lemma is_cnf_disj: "is_cnf (f1 ❙∨ f2) ⟹ (⋀f. f1 ❙∨ f2 = f ⟹ is_disj f ⟹ P) ⟹ P"
by auto
lemma cnf_to_dimacs_disj: "is_disj f ⟹ cnf_to_dimacs f = [disj_to_dimacs f]"
by (induction f) auto
lemma model_to_dimacs_model_all_clauses:
"1 < n_vars ⟹ (∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_cnf f ⟹ M ⊨ f ⟹
c∈set (cnf_to_dimacs f) ⟹ ∃l∈set (model_to_dimacs_model M [(1::nat)..<n_vars]). l ∈ set c"
proof(induction f arbitrary: )
case (Not f)
then show ?case
using in_model neg_in_model
by (fastforce elim!: is_lit_plus.elims)+
next
case (Or f1 f2)
then show ?case
using cnf_to_dimacs_disj disj_to_dimacs_sound
by(elim is_cnf_disj, simp)
qed (insert in_model neg_in_model pos_in_model, auto)
lemma upt_eq_Cons_conv:
"(x#xs = [i..<j]) = (i < j ∧ i = x ∧ [i+1..<j] = xs)"
using upt_eq_Cons_conv
by metis
lemma model_to_dimacs_model_append':
"(model_to_dimacs_model M (vs @ vs')) = (model_to_dimacs_model M vs) @ (model_to_dimacs_model M vs')"
by (induction vs) auto
lemma model_to_dimacs_neg_nin:
"n_vars ≤ x ⟹ int x ∉ set (model_to_dimacs_model M [a..<n_vars])"
by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')
lemma model_to_dimacs_pos_nin:
"n_vars ≤ x ⟹ - int x ∉ set (model_to_dimacs_model M [a..<n_vars])"
by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')
lemma int_cases2':
"z ≠ 0 ⟹ (⋀n. 0 ≠ (int n) ⟹ z = int n ⟹ P) ⟹ (⋀n. 0 ≠ - (int n) ⟹ z = - (int n) ⟹ P) ⟹ P"
by (metis (full_types) int_cases2)
lemma model_to_dimacs_model_distinct:
"1 < n_vars ⟹ distinct (map dimacs_lit_to_var (model_to_dimacs_model M [1..<n_vars]))"
by (induction n_vars)
(fastforce elim!: int_cases2'
simp add: dimacs_lit_to_var_def model_to_dimacs_model_append'
model_to_dimacs_neg_nin model_to_dimacs_pos_nin)+
lemma model_to_dimacs_model_sound:
"1 < n_vars ⟹ (∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_cnf f ⟹ M ⊨ f ⟹
dimacs_model (model_to_dimacs_model M [(1::nat)..<n_vars]) (cnf_to_dimacs f)"
unfolding dimacs_model_def
using model_to_dimacs_model_all_vars model_to_dimacs_model_all_clauses model_to_dimacs_model_distinct
by auto
lemma model_to_dimacs_model_sound_exists:
"1 < n_vars ⟹ (∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_cnf f ⟹ M ⊨ f ⟹
∃M_dimacs. dimacs_model M_dimacs (cnf_to_dimacs f)"
using model_to_dimacs_model_sound
by metis
definition dimacs_to_atom ::"int ⇒ nat formula" where
"dimacs_to_atom l ≡ if (l < 0) then Not (Atom (nat (abs l))) else Atom (nat (abs l))"
definition dimacs_to_disj::"int list ⇒ nat formula" where
"dimacs_to_disj f ≡ ❙⋁ (map dimacs_to_atom f)"
definition dimacs_to_cnf::"int list list ⇒ nat formula" where
"dimacs_to_cnf f ≡ ❙⋀map dimacs_to_disj f"
definition "dimacs_model_to_abs dimacs_M M ≡
fold (λl M. if (l > 0) then M((nat (abs l)):= True) else M((nat (abs l)):= False)) dimacs_M M"
lemma dimacs_model_to_abs_atom:
"0 < x ⟹ int x ∈ set dimacs_M ⟹ distinct (map dimacs_lit_to_var dimacs_M) ⟹ dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
case (snoc a dimacs_M)
thus ?case
by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto
lemma dimacs_model_to_abs_atom':
"0 < x ⟹ -(int x) ∈ set dimacs_M ⟹ distinct (map dimacs_lit_to_var dimacs_M) ⟹ ¬ dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
case (snoc a dimacs_M)
thus ?case
by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto
lemma model_to_dimacs_model_complete_disj:
"(∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_disj f ⟹ distinct (map dimacs_lit_to_var dimacs_M)
⟹ dimacs_model dimacs_M (cnf_to_dimacs f) ⟹ dimacs_model_to_abs dimacs_M (λ_. False) ⊨ f"
by (induction f)
(fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD
simp: cnf_to_dimacs_disj dimacs_model_def dimacs_model_to_abs_atom'
dimacs_model_to_abs_atom)+
lemma model_to_dimacs_model_complete:
"(∀v∈atoms f. 0 < v ∧ v < n_vars) ⟹ is_cnf f ⟹ distinct (map dimacs_lit_to_var dimacs_M)
⟹ dimacs_model dimacs_M (cnf_to_dimacs f) ⟹ dimacs_model_to_abs dimacs_M (λ_. False) ⊨ f"
proof(induction f)
case (Not f)
then show ?case
by (auto elim!: is_lit_plus.elims simp add: dimacs_model_to_abs_atom' dimacs_model_def)
next
case (Or f1 f2)
then show ?case
using cnf_to_dimacs_disj model_to_dimacs_model_complete_disj
by(elim is_cnf_disj, simp add: dimacs_model_def)
qed (insert dimacs_model_to_abs_atom, auto simp: dimacs_model_def)
lemma model_to_dimacs_model_complete_max_var:
"(∀v∈atoms f. 0 < v) ⟹ is_cnf f ⟹
dimacs_model dimacs_M (cnf_to_dimacs f) ⟹
dimacs_model_to_abs dimacs_M (λ_. False) ⊨ f"
using le_imp_less_Suc[OF max_var]
by (auto intro!: model_to_dimacs_model_complete simp: dimacs_model_def)
lemma model_to_dimacs_model_sound_max_var:
"(∀v∈atoms f. 0 < v) ⟹ is_cnf f ⟹ M ⊨ f ⟹
dimacs_model (model_to_dimacs_model M [(1::nat)..<(find_max (formula_vars f) + 2)])
(cnf_to_dimacs f)"
using le_imp_less_Suc[unfolded Suc_eq_plus1, OF max_var]
by (fastforce intro!: model_to_dimacs_model_sound)
context sat_solve_sasp
begin
lemma [simp]: "var_to_dimacs sv > 0"
by(cases sv) auto
lemma var_to_dimacs_pos:
"v ∈ atoms (map_formula var_to_dimacs f) ⟹ 0 < v"
by (induction f) auto
lemma map_is_disj: "is_disj f ⟹ is_disj (map_formula F f)"
by (induction f) (auto elim: is_lit_plus.elims)
lemma map_is_cnf: "is_cnf f ⟹ is_cnf (map_formula F f)"
by (induction f) (auto elim: is_lit_plus.elims simp: map_is_disj)
lemma planning_dimacs_complete:
"valid_plan πs ⟹ length πs ≤ h ⟹
let cnf_formula = (map_formula var_to_dimacs
(Φ⇩∀ (φ (prob_with_noop abs_prob)) h))
in
∃dimacs_M. dimacs_model dimacs_M (cnf_to_dimacs cnf_formula)"
unfolding Let_def
by (fastforce simp: var_to_dimacs_pos
dest!: planning_by_cnf_dimacs_complete
intro: model_to_dimacs_model_sound_max_var map_is_cnf
is_cnf_encode_problem_with_operator_interference_exclusion
is_valid_problem_sas_plus_then_strips_transformation_too
noops_valid abs_prob_valid)
lemma planning_dimacs_sound:
"let cnf_formula =
(map_formula var_to_dimacs
(Φ⇩∀ (φ (prob_with_noop abs_prob)) h))
in
dimacs_model dimacs_M (cnf_to_dimacs cnf_formula) ⟹
valid_plan
(decode_abs_plan
(rem_noops
(map (λop. φ⇩O¯ (prob_with_noop abs_prob) op)
(concat
(Φ¯ (φ (prob_with_noop abs_prob)) ((dimacs_model_to_abs dimacs_M (λ_. False)) o var_to_dimacs) h)))))"
by(fastforce simp: var_to_dimacs_pos Let_def
intro: planning_by_cnf_dimacs_sound model_to_dimacs_model_complete_max_var
map_is_cnf is_cnf_encode_problem_with_operator_interference_exclusion
is_valid_problem_sas_plus_then_strips_transformation_too abs_prob_valid
noops_valid)
end
section ‹Code Generation›
text ‹We now generate SML code equivalent to the functions that encode a problem as a CNF formula
and that decode the model of the given encodings into a plan.›
lemma [code]:
"dimacs_model ls cs ≡ (list_all (λc. list_ex (λl. ListMem l c ) ls) cs) ∧
distinct (map dimacs_lit_to_var ls)"
unfolding dimacs_model_def
by (auto simp: list.pred_set ListMem_iff list_ex_iff )
definition
"SASP_to_DIMACS h prob ≡
cnf_to_dimacs
(map_formula
(cnf_to_dimacs.var_to_dimacs (Suc h) (Suc (length (ast_problem.astδ prob))))
(Φ⇩∀ (φ (prob_with_noop (ast_problem.abs_prob prob))) h))"
lemma planning_dimacs_complete_code:
"⟦ast_problem.well_formed prob;
∀π∈set (ast_problem.astδ prob). is_standard_operator' π;
ast_problem.valid_plan prob πs;
length πs ≤ h⟧ ⟹
let cnf_formula = (SASP_to_DIMACS h prob) in
∃dimacs_M. dimacs_model dimacs_M cnf_formula"
unfolding SASP_to_DIMACS_def Let_def
apply(rule sat_solve_sasp.planning_dimacs_complete[unfolded Let_def])
apply unfold_locales
by auto
definition "SASP_to_DIMACS' h prob ≡ SASP_to_DIMACS h (rem_implicit_pres_ops prob)"
lemma planning_dimacs_complete_code':
"⟦ast_problem.well_formed prob;
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op);
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ is_standard_operator op);
ast_problem.valid_plan prob πs;
length πs ≤ h⟧ ⟹
let cnf_formula = (SASP_to_DIMACS' h prob) in
∃dimacs_M. dimacs_model dimacs_M cnf_formula"
unfolding Let_def SASP_to_DIMACS'_def
by (auto simp add: rem_implicit_pres_ops_valid_plan[symmetric] wf_ast_problem_def
simp del: rem_implicit_pres.simps
intro!: rem_implicit_pres_is_standard_operator'
planning_dimacs_complete_code[unfolded Let_def]
rem_implicit_pres_ops_well_formed
dest!: rem_implicit_pres_ops_inδD)
text ‹A function that does the checks required by the completeness theorem above, and returns
appropriate error messages if any of the checks fail.›
definition
"encode h prob ≡
if ast_problem.well_formed prob then
if (∀op ∈ set (ast_problem.astδ prob). consistent_pres_op op) then
if (∀op ∈ set (ast_problem.astδ prob). is_standard_operator op) then
Inl (SASP_to_DIMACS' h prob)
else
Inr (STR ''Error: Conditional effects!'')
else
Inr (STR ''Error: Preconditions inconsistent'')
else
Inr (STR ''Error: Problem malformed!'')"
lemma encode_sound:
"⟦ast_problem.valid_plan prob πs; length πs ≤ h;
encode h prob = Inl cnf_formula⟧ ⟹
(∃dimacs_M. dimacs_model dimacs_M cnf_formula)"
unfolding encode_def
by (auto split: if_splits simp: list.pred_set
intro: planning_dimacs_complete_code'[unfolded Let_def])
lemma encode_complete:
"encode h prob = Inr err ⟹
¬(ast_problem.well_formed prob ∧ (∀op ∈ set (ast_problem.astδ prob). consistent_pres_op op) ∧
(∀op ∈ set (ast_problem.astδ prob). is_standard_operator op))"
unfolding encode_def
by (auto split: if_splits simp: list.pred_set
intro: planning_dimacs_complete_code'[unfolded Let_def])
definition match_pre where
"match_pre ≡ λ(x,v) s. s x = Some v"
definition match_pres where
"match_pres pres s ≡ ∀pre∈set pres. match_pre pre s"
lemma match_pres_distinct:
"distinct (map fst pres) ⟹ match_pres pres s ⟷ Map.map_of pres ⊆⇩m s"
unfolding match_pres_def match_pre_def
using map_le_def map_of_SomeD
apply (auto split: prod.splits)
apply fastforce
using domI map_of_is_SomeI
by smt
fun tree_map_of where
"tree_map_of updatea T [] = T"
| "tree_map_of updatea T ((v,a)#m) = updatea v a (tree_map_of updatea T m)"
context Map
begin
abbreviation "tree_map_of' ≡ tree_map_of update"
lemma tree_map_of_invar: "invar T ⟹ invar (tree_map_of' T pres)"
by (induction pres) (auto simp add: invar_update)
lemma tree_map_of_works: "lookup (tree_map_of' empty pres) x = map_of pres x"
by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]])
lemma tree_map_of_dom: "dom (lookup (tree_map_of' empty pres)) = dom (map_of pres)"
by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]] tree_map_of_works)
end
lemma distinct_if_sorted: "sorted xs ⟹ distinct xs"
by (induction xs rule: induct_list012) auto
context Map_by_Ordered
begin
lemma tree_map_of_distinct: "distinct (map fst (inorder (tree_map_of' empty pres)))"
apply(induction pres)
apply(clarsimp simp: map_empty inorder_empty)
using distinct_if_sorted invar_def invar_empty invar_update tree_map_of_invar
by blast
end
lemma set_tree_intorder: "set_tree t = set (inorder t)"
by (induction t) auto
lemma map_of_eq:
"map_of xs = Map.map_of xs"
by (induction xs) (auto simp: map_of_simps split: option.split)
lemma lookup_someD: "lookup T x = Some y ⟹ ∃p. p ∈ set (inorder T) ∧ p = (x, y)"
by (induction T) (auto split: if_splits)
lemma map_of_lookup: "sorted1 (inorder T) ⟹ Map.map_of (inorder T) = lookup T"
apply(induction T)
apply (auto split: prod.splits intro!: map_le_antisym
simp: lookup_map_of map_add_Some_iff map_of_None2 sorted_wrt_append)
using lookup_someD
by (force simp: map_of_eq map_add_def map_le_def
split: option.splits)+
lemma map_le_cong: "(⋀x. m1 x = m2 x) ⟹ m1 ⊆⇩m s ⟷ m2 ⊆⇩m s"
by presburger
lemma match_pres_submap:
"match_pres (inorder (M.tree_map_of' empty pres)) s ⟷ Map.map_of pres ⊆⇩m s"
using match_pres_distinct[OF M.tree_map_of_distinct]
by (smt M.invar_def M.invar_empty M.tree_map_of_invar M.tree_map_of_works map_le_cong map_of_eq map_of_lookup)
lemma [code]:
"SAS_Plus_Representation.is_operator_applicable_in s op ⟷
match_pres (inorder (M.tree_map_of' empty (SAS_Plus_Representation.precondition_of op))) s"
by (simp add: match_pres_submap SAS_Plus_Representation.is_operator_applicable_in_def)
definition "decode_DIMACS_model dimacs_M h prob ≡
(ast_problem.decode_abs_plan prob
(rem_noops
(map (λop. φ⇩O¯ (prob_with_noop (ast_problem.abs_prob prob)) op)
(concat
(Φ¯ (φ (prob_with_noop (ast_problem.abs_prob prob)))
((dimacs_model_to_abs dimacs_M (λ_. False)) o
(cnf_to_dimacs.var_to_dimacs (Suc h)
(Suc (length (ast_problem.astδ prob)))))
h)))))"
lemma planning_dimacs_sound_code:
"⟦ast_problem.well_formed prob;
∀π∈set (ast_problem.astδ prob). is_standard_operator' π⟧ ⟹
let
cnf_formula = (SASP_to_DIMACS h prob);
decoded_plan = decode_DIMACS_model dimacs_M h prob
in
(dimacs_model dimacs_M cnf_formula ⟶ ast_problem.valid_plan prob decoded_plan)"
unfolding SASP_to_DIMACS_def decode_DIMACS_model_def Let_def
apply(rule impI sat_solve_sasp.planning_dimacs_sound[unfolded Let_def])+
apply unfold_locales
by auto
definition
"decode_DIMACS_model' dimacs_M h prob ≡
decode_DIMACS_model dimacs_M h (rem_implicit_pres_ops prob)"
lemma planning_dimacs_sound_code':
"⟦ast_problem.well_formed prob;
(⋀op. op ∈ set (ast_problem.astδ prob) ⟹ consistent_pres_op op);
∀π∈set (ast_problem.astδ prob). is_standard_operator π⟧ ⟹
let
cnf_formula = (SASP_to_DIMACS' h prob);
decoded_plan = decode_DIMACS_model' dimacs_M h prob
in
(dimacs_model dimacs_M cnf_formula ⟶ ast_problem.valid_plan prob decoded_plan)"
unfolding SASP_to_DIMACS'_def decode_DIMACS_model'_def
apply(subst rem_implicit_pres_ops_valid_plan[symmetric])
by(fastforce simp only: rem_implicit_pres_ops_valid_plan wf_ast_problem_def
intro!: rem_implicit_pres_is_standard_operator'
rem_implicit_pres_ops_well_formed
rev_iffD2[OF _ rem_implicit_pres_ops_valid_plan]
planning_dimacs_sound_code wf_ast_problem.intro
dest!: rem_implicit_pres_ops_inδD)+
text ‹Checking if the model satisfies the formula takes the longest time in the decoding function.
We reimplement that part using red black trees, which makes it 10 times faster, on average!›
fun list_to_rbt :: "int list ⇒ int rbt" where
"list_to_rbt [] = Leaf"
| "list_to_rbt (x#xs) = insert_rbt x (list_to_rbt xs)"
lemma inv_list_to_rbt: "invc (list_to_rbt xs) ∧ invh (list_to_rbt xs)"
by (induction xs) (auto simp: rbt_def RBT.inv_insert)
lemma Tree2_list_to_rbt: "Tree2.bst (list_to_rbt xs)"
by (induction xs) (auto simp: RBT.bst_insert)
lemma set_list_to_rbt: "Tree2.set_tree (list_to_rbt xs) = set xs"
by (induction xs) (simp add: RBT.set_tree_insert Tree2_list_to_rbt)+
text ‹The following ›
lemma dimacs_model_code[code]:
"dimacs_model ls cs ⟷
(let tls = list_to_rbt ls in
(∀c∈set cs. size (inter_rbt (tls) (list_to_rbt c)) ≠ 0) ∧
distinct (map dimacs_lit_to_var ls))"
using RBT.set_tree_inter[OF Tree2_list_to_rbt Tree2_list_to_rbt]
apply (auto simp: dimacs_model_def Let_def set_list_to_rbt inter_rbt_def)
apply (metis IntI RBT.set_empty empty_iff)
by (metis Tree2.eq_set_tree_empty disjoint_iff_not_equal)
definition
"decode M h prob ≡
if ast_problem.well_formed prob then
if (∀op∈set (ast_problem.astδ prob). consistent_pres_op op) then
if (∀op∈set (ast_problem.astδ prob). is_standard_operator op) then
if (dimacs_model M (SASP_to_DIMACS' h prob)) then
Inl (decode_DIMACS_model' M h prob)
else Inr (STR ''Error: Model does not solve the problem!'')
else
Inr (STR ''Error: Conditional effects!'')
else
Inr (STR ''Error: Preconditions inconsistent'')
else
Inr (STR ''Error: Problem malformed!'')"
lemma decode_sound:
"decode M h prob = Inl plan ⟹
ast_problem.valid_plan prob plan"
unfolding decode_def
apply (auto split: if_splits simp: list.pred_set)
using planning_dimacs_sound_code'
by auto
lemma decode_complete:
"decode M h prob = Inr err ⟹
¬ (ast_problem.well_formed prob ∧
(∀op ∈ set (ast_problem.astδ prob). consistent_pres_op op) ∧
(∀π∈set (ast_problem.astδ prob). is_standard_operator π) ∧
dimacs_model M (SASP_to_DIMACS' h prob))"
unfolding decode_def
by (auto split: if_splits simp: list.pred_set)
lemma [code]:
"ListMem x' []= False"
"ListMem x' (x#xs) = (x' = x ∨ ListMem x' xs)"
by (simp add: ListMem_iff)+
lemmas [code] = SASP_to_DIMACS_def ast_problem.abs_prob_def
ast_problem.abs_ast_variable_section_def ast_problem.abs_ast_operator_section_def
ast_problem.abs_ast_initial_state_def ast_problem.abs_range_map_def
ast_problem.abs_ast_goal_def cnf_to_dimacs.var_to_dimacs.simps
ast_problem.astδ_def ast_problem.astDom_def ast_problem.abs_ast_operator_def
ast_problem.astI_def ast_problem.astG_def ast_problem.lookup_action_def
ast_problem.I_def execute_operator_sas_plus_def ast_problem.decode_abs_plan_def
definition nat_opt_of_integer :: "integer ⇒ nat option" where
"nat_opt_of_integer i = (if (i ≥ 0) then Some (nat_of_integer i) else None)"
definition max_var :: "int list ⇒ int" where
"max_var xs ≡ fold (λ(x::int) (y::int). if abs x ≥ abs y then (abs x) else y) xs (0::int)"
export_code encode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
in SML module_name exported file_prefix SASP_to_DIMACS
export_code decode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
in SML module_name exported file_prefix decode_DIMACS_model
end